home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / dbgrids.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  101.6 KB  |  3,708 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DBGrids;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
  17.   Graphics, Grids, DBCtrls, Db, Menus;
  18.  
  19. type
  20.   TColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
  21.     cvTitleCaption, cvTitleAlignment, cvTitleFont);
  22.   TColumnValues = set of TColumnValue;
  23.  
  24. const
  25.   ColumnTitleValues = [cvTitleColor..cvTitleFont];
  26.   cm_DeferLayout = WM_USER + 100;
  27.  
  28. { TColumn defines internal storage for column attributes.  Values assigned
  29.   to properties are stored in this object, the grid- or field-based default
  30.   sources are not modified.  Values read from properties are the previously
  31.   assigned value, if any, or the grid- or field-based default values if
  32.   nothing has been assigned to that property. This class also publishes the
  33.   column attribute properties for persistent storage.  }
  34. type
  35.   TColumn = class;
  36.   TCustomDBGrid = class;
  37.  
  38.   TColumnTitle = class(TPersistent)
  39.   private
  40.     FColumn: TColumn;
  41.     FCaption: string;
  42.     FFont: TFont;
  43.     FColor: TColor;
  44.     FAlignment: TAlignment;
  45.     procedure FontChanged(Sender: TObject);
  46.     function GetAlignment: TAlignment;
  47.     function GetColor: TColor;
  48.     function GetCaption: string;
  49.     function GetFont: TFont;
  50.     function IsAlignmentStored: Boolean;
  51.     function IsColorStored: Boolean;
  52.     function IsFontStored: Boolean;
  53.     function IsCaptionStored: Boolean;
  54.     procedure SetAlignment(Value: TAlignment);
  55.     procedure SetColor(Value: TColor);
  56.     procedure SetFont(Value: TFont);
  57.     procedure SetCaption(const Value: string); virtual;
  58.   protected
  59.     procedure RefreshDefaultFont;
  60.   public
  61.     constructor Create(Column: TColumn);
  62.     destructor Destroy; override;
  63.     procedure Assign(Source: TPersistent); override;
  64.     function DefaultAlignment: TAlignment;
  65.     function DefaultColor: TColor;
  66.     function DefaultFont: TFont;
  67.     function DefaultCaption: string;
  68.     procedure RestoreDefaults; virtual;
  69.   published
  70.     property Alignment: TAlignment read GetAlignment write SetAlignment
  71.       stored IsAlignmentStored;
  72.     property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
  73.     property Color: TColor read GetColor write SetColor stored IsColorStored;
  74.     property Font: TFont read GetFont write SetFont stored IsFontStored;
  75.   end;
  76.  
  77.   TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);
  78.  
  79.   TColumn = class(TCollectionItem)
  80.   private
  81.     FField: TField;
  82.     FFieldName: string;
  83.     FColor: TColor;
  84.     FWidth: Integer;
  85.     FTitle: TColumnTitle;
  86.     FFont: TFont;
  87.     FPickList: TStrings;
  88.     FPopupMenu: TPopupMenu;
  89.     FDropDownRows: Cardinal;
  90.     FButtonStyle: TColumnButtonStyle;
  91.     FAlignment: TAlignment;
  92.     FReadonly: Boolean;
  93.     FAssignedValues: TColumnValues;
  94.     procedure FontChanged(Sender: TObject);
  95.     function  GetAlignment: TAlignment;
  96.     function  GetColor: TColor;
  97.     function  GetField: TField;
  98.     function  GetFont: TFont;
  99.     function  GetPickList: TStrings;
  100.     function  GetReadOnly: Boolean;
  101.     function  GetWidth: Integer;
  102.     function  IsAlignmentStored: Boolean;
  103.     function  IsColorStored: Boolean;
  104.     function  IsFontStored: Boolean;
  105.     function  IsReadOnlyStored: Boolean;
  106.     function  IsWidthStored: Boolean;
  107.     procedure SetAlignment(Value: TAlignment); virtual;
  108.     procedure SetButtonStyle(Value: TColumnButtonStyle);
  109.     procedure SetColor(Value: TColor);
  110.     procedure SetField(Value: TField); virtual;
  111.     procedure SetFieldName(const Value: String);
  112.     procedure SetFont(Value: TFont);
  113.     procedure SetPickList(Value: TStrings);
  114.     procedure SetPopupMenu(Value: TPopupMenu);
  115.     procedure SetReadOnly(Value: Boolean); virtual;
  116.     procedure SetTitle(Value: TColumnTitle);
  117.     procedure SetWidth(Value: Integer); virtual;
  118.   protected
  119.     function  CreateTitle: TColumnTitle; virtual;
  120.     function  GetGrid: TCustomDBGrid;
  121.     function GetDisplayName: string; override;
  122.     procedure RefreshDefaultFont;
  123.   public
  124.     constructor Create(Collection: TCollection); override;
  125.     destructor Destroy; override;
  126.     procedure Assign(Source: TPersistent); override;
  127.     function  DefaultAlignment: TAlignment;
  128.     function  DefaultColor: TColor;
  129.     function  DefaultFont: TFont;
  130.     function  DefaultReadOnly: Boolean;
  131.     function  DefaultWidth: Integer;
  132.     procedure RestoreDefaults; virtual;
  133.     property  Grid: TCustomDBGrid read GetGrid;
  134.     property  AssignedValues: TColumnValues read FAssignedValues;
  135.     property  Field: TField read GetField write SetField;
  136.   published
  137.     property  Alignment: TAlignment read GetAlignment write SetAlignment
  138.       stored IsAlignmentStored;
  139.     property  ButtonStyle: TColumnButtonStyle read FButtonStyle write SetButtonStyle
  140.       default cbsAuto;
  141.     property  Color: TColor read GetColor write SetColor stored IsColorStored;
  142.     property  DropDownRows: Cardinal read FDropDownRows write FDropDownRows default 7;
  143.     property  FieldName: String read FFieldName write SetFieldName;
  144.     property  Font: TFont read GetFont write SetFont stored IsFontStored;
  145.     property  PickList: TStrings read GetPickList write SetPickList;
  146.     property  PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  147.     property  ReadOnly: Boolean read GetReadOnly write SetReadOnly
  148.       stored IsReadOnlyStored;
  149.     property  Title: TColumnTitle read FTitle write SetTitle;
  150.     property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
  151.   end;
  152.  
  153.   TColumnClass = class of TColumn;
  154.  
  155.   TDBGridColumnsState = (csDefault, csCustomized);
  156.  
  157.   TDBGridColumns = class(TCollection)
  158.   private
  159.     FGrid: TCustomDBGrid;
  160.     function GetColumn(Index: Integer): TColumn;
  161.     function GetState: TDBGridColumnsState;
  162.     procedure SetColumn(Index: Integer; Value: TColumn);
  163.     procedure SetState(NewState: TDBGridColumnsState);
  164.   protected
  165.     function GetOwner: TPersistent; override;
  166.     procedure Update(Item: TCollectionItem); override;
  167.   public
  168.     constructor Create(Grid: TCustomDBGrid; ColumnClass: TColumnClass);
  169.     function  Add: TColumn;
  170.     procedure LoadFromFile(const Filename: string);
  171.     procedure LoadFromStream(S: TStream);
  172.     procedure RestoreDefaults;
  173.     procedure RebuildColumns;
  174.     procedure SaveToFile(const Filename: string);
  175.     procedure SaveToStream(S: TStream);
  176.     property State: TDBGridColumnsState read GetState write SetState;
  177.     property Grid: TCustomDBGrid read FGrid;
  178.     property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
  179.   end;
  180.  
  181.   TGridDataLink = class(TDataLink)
  182.   private
  183.     FGrid: TCustomDBGrid;
  184.     FFieldCount: Integer;
  185.     FFieldMapSize: Integer;
  186.     FFieldMap: Pointer;
  187.     FModified: Boolean;
  188.     FInUpdateData: Boolean;
  189.     FSparseMap: Boolean;
  190.     function GetDefaultFields: Boolean;
  191.     function GetFields(I: Integer): TField;
  192.   protected
  193.     procedure ActiveChanged; override;
  194.     procedure DataSetChanged; override;
  195.     procedure DataSetScrolled(Distance: Integer); override;
  196.     procedure FocusControl(Field: TFieldRef); override;
  197.     procedure EditingChanged; override;
  198.     procedure LayoutChanged; override;
  199.     procedure RecordChanged(Field: TField); override;
  200.     procedure UpdateData; override;
  201.     function  GetMappedIndex(ColIndex: Integer): Integer;
  202.   public
  203.     constructor Create(AGrid: TCustomDBGrid);
  204.     destructor Destroy; override;
  205.     function AddMapping(const FieldName: string): Boolean;
  206.     procedure ClearMapping;
  207.     procedure Modified;
  208.     procedure Reset;
  209.     property DefaultFields: Boolean read GetDefaultFields;
  210.     property FieldCount: Integer read FFieldCount;
  211.     property Fields[I: Integer]: TField read GetFields;
  212.     property SparseMap: Boolean read FSparseMap write FSparseMap;
  213.   end;
  214.  
  215.   TBookmarkList = class
  216.   private
  217.     FList: TStringList;
  218.     FGrid: TCustomDBGrid;
  219.     FCache: TBookmarkStr;
  220.     FCacheIndex: Integer;
  221.     FCacheFind: Boolean;
  222.     FLinkActive: Boolean;
  223.     function GetCount: Integer;
  224.     function GetCurrentRowSelected: Boolean;
  225.     function GetItem(Index: Integer): TBookmarkStr;
  226.     procedure SetCurrentRowSelected(Value: Boolean);
  227.     procedure StringsChanged(Sender: TObject);
  228.   protected
  229.     function CurrentRow: TBookmarkStr;  
  230.     function Compare(const Item1, Item2: TBookmarkStr): Integer;
  231.     procedure LinkActive(Value: Boolean);
  232.   public
  233.     constructor Create(AGrid: TCustomDBGrid);
  234.     destructor Destroy; override;
  235.     procedure Clear;           // free all bookmarks
  236.     procedure Delete;          // delete all selected rows from dataset
  237.     function  Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
  238.     function  IndexOf(const Item: TBookmarkStr): Integer;
  239.     function  Refresh: Boolean;// drop orphaned bookmarks; True = orphans found
  240.     property Count: Integer read GetCount;
  241.     property CurrentRowSelected: Boolean read GetCurrentRowSelected
  242.       write SetCurrentRowSelected;
  243.     property Items[Index: Integer]: TBookmarkStr read GetItem; default;
  244.   end;
  245.  
  246.   TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
  247.     dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
  248.     dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect);
  249.   TDBGridOptions = set of TDBGridOption;
  250.  
  251.   { The DBGrid's DrawDataCell virtual method and OnDrawDataCell event are only
  252.     called when the grid's Columns.State is csDefault.  This is for compatibility
  253.     with existing code. These routines don't provide sufficient information to
  254.     determine which column is being drawn, so the column attributes aren't
  255.     easily accessible in these routines.  Column attributes also introduce the
  256.     possibility that a column's field may be nil, which would break existing
  257.     DrawDataCell code.   DrawDataCell, OnDrawDataCell, and DefaultDrawDataCell
  258.     are obsolete, retained for compatibility purposes. }
  259.   TDrawDataCellEvent = procedure (Sender: TObject; const Rect: TRect; Field: TField;
  260.     State: TGridDrawState) of object;
  261.  
  262.   { The DBGrid's DrawColumnCell virtual method and OnDrawColumnCell event are
  263.     always called, when the grid has defined column attributes as well as when
  264.     it is in default mode.  These new routines provide the additional
  265.     information needed to access the column attributes for the cell being
  266.     drawn, and must support nil fields.  }
  267.  
  268.   TDrawColumnCellEvent = procedure (Sender: TObject; const Rect: TRect;
  269.     DataCol: Integer; Column: TColumn; State: TGridDrawState) of object;
  270.   TDBGridClickEvent = procedure (Column: TColumn) of object;
  271.  
  272.   TCustomDBGrid = class(TCustomGrid)
  273.   private
  274.     FIndicators: TImageList;
  275.     FTitleFont: TFont;
  276.     FReadOnly: Boolean;
  277.     FUserChange: Boolean;
  278.     FLayoutFromDataset: Boolean;
  279.     FOptions: TDBGridOptions;
  280.     FTitleOffset, FIndicatorOffset: Byte;
  281.     FUpdateLock: Byte;
  282.     FLayoutLock: Byte;
  283.     FInColExit: Boolean;
  284.     FDefaultDrawing: Boolean;
  285.     FSelfChangingTitleFont: Boolean;
  286.     FSelecting: Boolean;
  287.     FSelRow: Integer;
  288.     FDataLink: TGridDataLink;
  289.     FOnColEnter: TNotifyEvent;
  290.     FOnColExit: TNotifyEvent;
  291.     FOnDrawDataCell: TDrawDataCellEvent;
  292.     FOnDrawColumnCell: TDrawColumnCellEvent;
  293.     FEditText: string;
  294.     FColumns: TDBGridColumns;
  295.     FOnEditButtonClick: TNotifyEvent;
  296.     FOnColumnMoved: TMovedEvent;
  297.     FBookmarks: TBookmarkList;
  298.     FSelectionAnchor: TBookmarkStr;
  299.     FOnCellClick: TDBGridClickEvent;
  300.     FOnTitleClick:TDBGridClickEvent;
  301.     function AcquireFocus: Boolean;
  302.     procedure DataChanged;
  303.     procedure EditingChanged;
  304.     function GetDataSource: TDataSource;
  305.     function GetFieldCount: Integer;
  306.     function GetFields(FieldIndex: Integer): TField;
  307.     function GetSelectedField: TField;
  308.     function GetSelectedIndex: Integer;
  309.     procedure InternalLayout;
  310.     procedure MoveCol(RawCol: Integer);
  311.     procedure RecordChanged(Field: TField);
  312.     procedure SetColumns(Value: TDBGridColumns);
  313.     procedure SetDataSource(Value: TDataSource);
  314.     procedure SetOptions(Value: TDBGridOptions);
  315.     procedure SetSelectedField(Value: TField);
  316.     procedure SetSelectedIndex(Value: Integer);
  317.     procedure SetTitleFont(Value: TFont);
  318.     procedure TitleFontChanged(Sender: TObject);
  319.     procedure UpdateData;
  320.     procedure UpdateActive;
  321.     procedure UpdateScrollBar;
  322.     procedure UpdateRowCount;
  323.     procedure CMExit(var Message: TMessage); message CM_EXIT;
  324.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  325.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
  326.     procedure CMDeferLayout(var Message); message cm_DeferLayout;
  327.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  328.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  329.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  330.     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  331.   protected
  332.     FUpdateFields: Boolean;
  333.     FAcquireFocus: Boolean;
  334.     function  RawToDataColumn(ACol: Integer): Integer;
  335.     function  DataToRawColumn(ACol: Integer): Integer;
  336.     function  AcquireLayoutLock: Boolean;
  337.     procedure BeginLayout;
  338.     procedure BeginUpdate;
  339.     procedure CancelLayout;
  340.     function  CanEditAcceptKey(Key: Char): Boolean; override;
  341.     function  CanEditModify: Boolean; override;
  342.     function  CanEditShow: Boolean; override;
  343.     procedure CellClick(Column: TColumn); dynamic;
  344.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  345.     procedure ColEnter; dynamic;
  346.     procedure ColExit; dynamic;
  347.     procedure ColWidthsChanged; override;
  348.     function  CreateColumns: TDBGridColumns; dynamic;
  349.     function  CreateEditor: TInplaceEdit; override;
  350.     procedure CreateWnd; override;
  351.     procedure DeferLayout;
  352.     procedure DefaultHandler(var Msg); override;
  353.     procedure DefineFieldMap; virtual;
  354.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  355.     procedure DrawDataCell(const Rect: TRect; Field: TField;
  356.       State: TGridDrawState); dynamic; { obsolete }
  357.     procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
  358.       Column: TColumn; State: TGridDrawState); dynamic;
  359.     procedure EditButtonClick; dynamic;
  360.     procedure EndLayout;
  361.     procedure EndUpdate;
  362.     function  GetColField(DataCol: Integer): TField;
  363.     function  GetEditLimit: Integer; override;
  364.     function  GetEditMask(ACol, ARow: Longint): string; override;
  365.     function  GetEditText(ACol, ARow: Longint): string; override;
  366.     function  GetFieldValue(ACol: Integer): string;
  367.     function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
  368.       AState: TGridDrawState): Boolean; virtual;
  369.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  370.     procedure KeyPress(var Key: Char); override;
  371.     procedure LayoutChanged; virtual;
  372.     procedure LinkActive(Value: Boolean); virtual;
  373.     procedure Loaded; override;
  374.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  375.       X, Y: Integer); override;
  376.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  377.       X, Y: Integer); override;
  378.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  379.     procedure Scroll(Distance: Integer); virtual;
  380.     procedure SetColumnAttributes; virtual;
  381.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  382.     function  StoreColumns: Boolean;
  383.     procedure TimedScroll(Direction: TGridScrollDirection); override;
  384.     procedure TitleClick(Column: TColumn); dynamic;
  385.     property Columns: TDBGridColumns read FColumns write SetColumns;
  386.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
  387.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  388.     property DataLink: TGridDataLink read FDataLink;
  389.     property IndicatorOffset: Byte read FIndicatorOffset;
  390.     property LayoutLock: Byte read FLayoutLock;
  391.     property Options: TDBGridOptions read FOptions write SetOptions
  392.       default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
  393.       dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
  394.     property ParentColor default False;
  395.     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  396.     property SelectedRows: TBookmarkList read FBookmarks;
  397.     property TitleFont: TFont read FTitleFont write SetTitleFont;
  398.     property UpdateLock: Byte read FUpdateLock;
  399.     property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
  400.     property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
  401.     property OnDrawDataCell: TDrawDataCellEvent read FOnDrawDataCell
  402.       write FOnDrawDataCell; { obsolete }
  403.     property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell
  404.       write FOnDrawColumnCell;
  405.     property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
  406.       write FOnEditButtonClick;
  407.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
  408.     property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
  409.     property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
  410.   public
  411.     constructor Create(AOwner: TComponent); override;
  412.     destructor Destroy; override;
  413.     procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
  414.       State: TGridDrawState); { obsolete }
  415.     procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
  416.       Column: TColumn; State: TGridDrawState);
  417.     function ValidFieldIndex(FieldIndex: Integer): Boolean;
  418.     property EditorMode;
  419.     property FieldCount: Integer read GetFieldCount;
  420.     property Fields[FieldIndex: Integer]: TField read GetFields;
  421.     property SelectedField: TField read GetSelectedField write SetSelectedField;
  422.     property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
  423.   end;
  424.  
  425.   TDBGrid = class(TCustomDBGrid)
  426.   public
  427.     property Canvas;
  428.     property SelectedRows;
  429.   published
  430.     property Align;
  431.     property BorderStyle;
  432.     property Color;
  433.     property Columns stored StoreColumns;
  434.     property Ctl3D;
  435.     property DataSource;
  436.     property DefaultDrawing;
  437.     property DragCursor;
  438.     property DragMode;
  439.     property Enabled;
  440.     property FixedColor;
  441.     property Font;
  442.     property ImeMode;
  443.     property ImeName;
  444.     property Options;
  445.     property ParentColor;
  446.     property ParentCtl3D;
  447.     property ParentFont;
  448.     property ParentShowHint;
  449.     property PopupMenu;
  450.     property ReadOnly;
  451.     property ShowHint;
  452.     property TabOrder;
  453.     property TabStop;
  454.     property TitleFont;
  455.     property Visible;
  456.     property OnCellClick;
  457.     property OnColEnter;
  458.     property OnColExit;
  459.     property OnColumnMoved;
  460.     property OnDrawDataCell;  { obsolete }
  461.     property OnDrawColumnCell;
  462.     property OnDblClick;
  463.     property OnDragDrop;
  464.     property OnDragOver;
  465.     property OnEditButtonClick;
  466.     property OnEndDrag;
  467.     property OnEnter;
  468.     property OnExit;
  469.     property OnKeyDown;
  470.     property OnKeyPress;
  471.     property OnKeyUp;
  472.     property OnStartDrag;
  473.     property OnTitleClick;
  474.   end;
  475.  
  476. const
  477.   IndicatorWidth = 11;
  478.  
  479. implementation
  480.  
  481. uses DBConsts, Dialogs;
  482.  
  483. {$R DBGRIDS.RES}
  484.  
  485. const
  486.   bmArrow = 'DBGARROW';
  487.   bmEdit = 'DBEDIT';
  488.   bmInsert = 'DBINSERT';
  489.  
  490.   MaxMapSize = (MaxInt div 2) div SizeOf(Integer);  { 250 million }
  491.  
  492. { Error reporting }
  493.  
  494. procedure RaiseGridError(const S: string);
  495. begin
  496.   raise EInvalidGridOperation.Create(S);
  497. end;
  498.  
  499. {procedure GridError(S: Word);
  500. begin
  501.   RaiseGridError(LoadStr(S));
  502. end;}
  503.  
  504. { TDBGridInplaceEdit }
  505.  
  506. { TDBGridInplaceEdit adds support for a button on the in-place editor,
  507.   which can be used to drop down a table-based lookup list, a stringlist-based
  508.   pick list, or (if button style is esEllipsis) fire the grid event
  509.   OnEditButtonClick.  }
  510.  
  511. type
  512.   TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
  513.   TPopupListbox = class;
  514.  
  515.   TDBGridInplaceEdit = class(TInplaceEdit)
  516.   private
  517.     FButtonWidth: Integer;
  518.     FDataList: TDBLookupListBox;
  519.     FPickList: TPopupListbox;
  520.     FActiveList: TWinControl;
  521.     FLookupSource: TDatasource;
  522.     FEditStyle: TEditStyle;
  523.     FListVisible: Boolean;
  524.     FTracking: Boolean;
  525.     FPressed: Boolean;
  526.     procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
  527.       Shift: TShiftState; X, Y: Integer);
  528.     procedure SetEditStyle(Value: TEditStyle);
  529.     procedure StopTracking;
  530.     procedure TrackButton(X,Y: Integer);
  531.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
  532.     procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
  533.     procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
  534.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
  535.     procedure WMPaint(var Message: TWMPaint); message wm_Paint;
  536.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
  537.   protected
  538.     procedure BoundsChanged; override;
  539.     procedure CloseUp(Accept: Boolean);
  540.     procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
  541.     procedure DropDown;
  542.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  543.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  544.       X, Y: Integer); override;
  545.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  546.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  547.       X, Y: Integer); override;
  548.     procedure PaintWindow(DC: HDC); override;
  549.     procedure UpdateContents; override;
  550.     procedure WndProc(var Message: TMessage); override;
  551.     property  EditStyle: TEditStyle read FEditStyle write SetEditStyle;
  552.     property  ActiveList: TWinControl read FActiveList write FActiveList;
  553.     property  DataList: TDBLookupListBox read FDataList;
  554.     property  PickList: TPopupListbox read FPickList;
  555.   public
  556.     constructor Create(Owner: TComponent); override;
  557.   end;
  558.  
  559. { TPopupListbox }
  560.  
  561.   TPopupListbox = class(TCustomListbox)
  562.   private
  563.     FSearchText: String;
  564.     FSearchTickCount: Longint;
  565.   protected
  566.     procedure CreateParams(var Params: TCreateParams); override;
  567.     procedure CreateWnd; override;
  568.     procedure KeyPress(var Key: Char); override;
  569.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  570.   end;
  571.  
  572. procedure TPopupListBox.CreateParams(var Params: TCreateParams);
  573. begin
  574.   inherited CreateParams(Params);
  575.   with Params do
  576.   begin
  577.     Style := Style or WS_BORDER;
  578.     ExStyle := WS_EX_TOOLWINDOW;
  579.     WindowClass.Style := CS_SAVEBITS;
  580.   end;
  581. end;
  582.  
  583. procedure TPopupListbox.CreateWnd;
  584. begin
  585.   inherited CreateWnd;
  586.   Windows.SetParent(Handle, 0);
  587.   CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
  588. end;
  589.  
  590. procedure TPopupListbox.Keypress(var Key: Char);
  591. var
  592.   TickCount: Integer;
  593. begin
  594.   case Key of
  595.     #8, #27: FSearchText := '';
  596.     #32..#255:
  597.       begin
  598.         TickCount := GetTickCount;
  599.         if TickCount - FSearchTickCount > 2000 then FSearchText := '';
  600.         FSearchTickCount := TickCount;
  601.         if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
  602.         SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
  603.         Key := #0;
  604.       end;
  605.   end;
  606.   inherited Keypress(Key);
  607. end;
  608.  
  609. procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  610.   X, Y: Integer);
  611. begin
  612.   inherited MouseUp(Button, Shift, X, Y);
  613.   TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
  614.       (X < Width) and (Y < Height));
  615. end;
  616.  
  617.  
  618. constructor TDBGridInplaceEdit.Create(Owner: TComponent);
  619. begin
  620.   inherited Create(Owner);
  621.   FLookupSource := TDataSource.Create(Self);
  622.   FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  623.   FEditStyle := esSimple;
  624. end;
  625.  
  626. procedure TDBGridInplaceEdit.BoundsChanged;
  627. var
  628.   R: TRect;
  629. begin
  630.   SetRect(R, 2, 2, Width - 2, Height);
  631.   if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
  632.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  633.   SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  634. end;
  635.  
  636. procedure TDBGridInplaceEdit.CloseUp(Accept: Boolean);
  637. var
  638.   MasterField: TField;
  639.   ListValue: Variant;
  640. begin
  641.   if FListVisible then
  642.   begin
  643.     if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  644.     if FActiveList = FDataList then
  645.       ListValue := FDataList.KeyValue
  646.     else
  647.       if FPickList.ItemIndex <> -1 then
  648.         ListValue := FPickList.Items[FPicklist.ItemIndex];
  649.     SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
  650.       SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  651.     FListVisible := False;
  652.     if Assigned(FDataList) then
  653.       FDataList.ListSource := nil;
  654.     FLookupSource.Dataset := nil;
  655.     Invalidate;
  656.     if Accept then
  657.       if FActiveList = FDataList then
  658.         with TCustomDBGrid(Grid), Columns[SelectedIndex].Field do
  659.         begin
  660.           MasterField := DataSet.FieldByName(KeyFields);
  661.           if MasterField.CanModify then
  662.           begin
  663.             DataSet.Edit;
  664.             MasterField.Value := ListValue;
  665.           end;
  666.         end
  667.       else
  668.         if (not VarIsNull(ListValue)) and EditCanModify then
  669.           with TCustomDBGrid(Grid), Columns[SelectedIndex].Field do
  670.             Text := ListValue;
  671.   end;
  672. end;
  673.  
  674. procedure TDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
  675. begin
  676.   case Key of
  677.     VK_UP, VK_DOWN:
  678.       if ssAlt in Shift then
  679.       begin
  680.         if FListVisible then CloseUp(True) else DropDown;
  681.         Key := 0;
  682.       end;
  683.     VK_RETURN, VK_ESCAPE:
  684.       if FListVisible and not (ssAlt in Shift) then
  685.       begin
  686.         CloseUp(Key = VK_RETURN);
  687.         Key := 0;
  688.       end;
  689.   end;
  690. end;
  691.  
  692. procedure TDBGridInplaceEdit.DropDown;
  693. var
  694.   P: TPoint;
  695.   I,J,Y: Integer;
  696.   Column: TColumn;
  697. begin
  698.   if not FListVisible and Assigned(FActiveList) then
  699.   begin
  700.     FActiveList.Width := Width;
  701.     with TCustomDBGrid(Grid) do
  702.       Column := Columns[SelectedIndex];
  703.     if FActiveList = FDataList then
  704.     with Column.Field do
  705.     begin
  706.       FDataList.Color := Color;
  707.       FDataList.Font := Font;
  708.       FDataList.RowCount := Column.DropDownRows;
  709.       FLookupSource.DataSet := LookupDataSet;
  710.       FDataList.KeyField := LookupKeyFields;
  711.       FDataList.ListField := LookupResultField;
  712.       FDataList.ListSource := FLookupSource;
  713.       FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
  714. {      J := Column.DefaultWidth;
  715.       if J > FDataList.ClientWidth then
  716.         FDataList.ClientWidth := J;
  717. }    end
  718.     else
  719.     begin
  720.       FPickList.Color := Color;
  721.       FPickList.Font := Font;
  722.       FPickList.Items := Column.Picklist;
  723.       if FPickList.Items.Count >= Column.DropDownRows then
  724.         FPickList.Height := Column.DropDownRows * FPickList.ItemHeight + 4
  725.       else
  726.         FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
  727.       if Column.Field.IsNull then
  728.         FPickList.ItemIndex := -1
  729.       else
  730.         FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Value);
  731.       J := FPickList.ClientWidth;
  732.       for I := 0 to FPickList.Items.Count - 1 do
  733.       begin
  734.         Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
  735.         if Y > J then J := Y;
  736.       end;
  737.       FPickList.ClientWidth := J;
  738.     end;
  739.     P := Parent.ClientToScreen(Point(Left, Top));
  740.     Y := P.Y + Height;
  741.     if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
  742.     SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
  743.       SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  744.     FListVisible := True;
  745.     Invalidate;
  746.     Windows.SetFocus(Handle);
  747.   end;
  748. end;
  749.  
  750. type
  751.   TWinControlCracker = class(TWinControl) end;
  752.  
  753. procedure TDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  754. var
  755.   Msg: TMsg;
  756. begin
  757.   if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
  758.   begin
  759.     TCustomDBGrid(Grid).EditButtonClick;
  760.     PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE);
  761.   end
  762.   else
  763.     inherited KeyDown(Key, Shift);
  764. end;
  765.  
  766. procedure TDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
  767.   Shift: TShiftState; X, Y: Integer);
  768. begin
  769.   if Button = mbLeft then
  770.     CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
  771. end;
  772.  
  773. procedure TDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  774.   X, Y: Integer);
  775. begin
  776.   if (Button = mbLeft) and (FEditStyle <> esSimple) and
  777.     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
  778.   begin
  779.     if FListVisible then
  780.       CloseUp(False)
  781.     else
  782.     begin
  783.       MouseCapture := True;
  784.       FTracking := True;
  785.       TrackButton(X, Y);
  786.       if Assigned(FActiveList) then
  787.         DropDown;
  788.     end;
  789.   end;
  790.   inherited MouseDown(Button, Shift, X, Y);
  791. end;
  792.  
  793. procedure TDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
  794. var
  795.   ListPos: TPoint;
  796.   MousePos: TSmallPoint;
  797. begin
  798.   if FTracking then
  799.   begin
  800.     TrackButton(X, Y);
  801.     if FListVisible then
  802.     begin
  803.       ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
  804.       if PtInRect(FActiveList.ClientRect, ListPos) then
  805.       begin
  806.         StopTracking;
  807.         MousePos := PointToSmallPoint(ListPos);
  808.         SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
  809.         Exit;
  810.       end;
  811.     end;
  812.   end;
  813.   inherited MouseMove(Shift, X, Y);
  814. end;
  815.  
  816. procedure TDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  817.   X, Y: Integer);
  818. var
  819.   WasPressed: Boolean;
  820. begin
  821.   WasPressed := FPressed;
  822.   StopTracking;
  823.   if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
  824.     TCustomDBGrid(Grid).EditButtonClick;
  825.   inherited MouseUp(Button, Shift, X, Y);
  826. end;
  827.  
  828. procedure TDBGridInplaceEdit.PaintWindow(DC: HDC);
  829. var
  830.   R: TRect;
  831.   Flags: Integer;
  832.   W: Integer;
  833. begin
  834.   if FEditStyle <> esSimple then
  835.   begin
  836.     SetRect(R, Width - FButtonWidth, 0, Width, Height);
  837.     Flags := 0;
  838.     if FEditStyle in [esDataList, esPickList] then
  839.     begin
  840.       if FActiveList = nil then
  841.         Flags := DFCS_INACTIVE
  842.       else if FPressed then
  843.         Flags := DFCS_FLAT or DFCS_PUSHED;
  844.       DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
  845.     end
  846.     else   { esEllipsis }
  847.     begin
  848.       if FPressed then
  849.         Flags := BF_FLAT;
  850.       DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
  851.       Flags := ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
  852.       W := Height shr 3;
  853.       if W = 0 then W := 1;
  854.       PatBlt(DC, R.Left + Flags, R.Top + Flags, W, W, BLACKNESS);
  855.       PatBlt(DC, R.Left + Flags - (W * 2), R.Top + Flags, W, W, BLACKNESS);
  856.       PatBlt(DC, R.Left + Flags + (W * 2), R.Top + Flags, W, W, BLACKNESS);
  857.     end;
  858.     ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  859.   end;
  860.   inherited PaintWindow(DC);
  861. end;
  862.  
  863. procedure TDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
  864. begin
  865.   if Value = FEditStyle then Exit;
  866.   FEditStyle := Value;
  867.   case Value of
  868.     esPickList:
  869.       begin
  870.         if FPickList = nil then
  871.         begin
  872.           FPickList := TPopupListbox.Create(Self);
  873.           FPickList.Visible := False;
  874.           FPickList.Parent := Self;
  875.           FPickList.OnMouseUp := ListMouseUp;
  876.           FPickList.IntegralHeight := True;
  877.           FPickList.ItemHeight := 11;
  878.         end;
  879.         FActiveList := FPickList;
  880.       end;
  881.     esDataList:
  882.       begin
  883.         if FDataList = nil then
  884.         begin
  885.           FDataList := TPopupDataList.Create(Self);
  886.           FDataList.Visible := False;
  887.           FDataList.Parent := Self;
  888.           FDataList.OnMouseUp := ListMouseUp;
  889.         end;
  890.         FActiveList := FDataList;
  891.       end;
  892.   else  { cbsNone, cbsEllipsis, or read only field }
  893.     FActiveList := nil;
  894.   end;
  895.   with TCustomDBGrid(Grid) do
  896.     Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
  897.   Repaint;
  898. end;
  899.  
  900. procedure TDBGridInplaceEdit.StopTracking;
  901. begin
  902.   if FTracking then
  903.   begin
  904.     TrackButton(-1, -1);
  905.     FTracking := False;
  906.     MouseCapture := False;
  907.   end;
  908. end;
  909.  
  910. procedure TDBGridInplaceEdit.TrackButton(X,Y: Integer);
  911. var
  912.   NewState: Boolean;
  913.   R: TRect;
  914. begin
  915.   SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
  916.   NewState := PtInRect(R, Point(X, Y));
  917.   if FPressed <> NewState then
  918.   begin
  919.     FPressed := NewState;
  920.     InvalidateRect(Handle, @R, False);
  921.   end;
  922. end;
  923.  
  924. procedure TDBGridInplaceEdit.UpdateContents;
  925. var
  926.   Column: TColumn;
  927.   NewStyle: TEditStyle;
  928.   MasterField: TField;
  929. begin
  930.   with TCustomDBGrid(Grid) do
  931.     Column := Columns[SelectedIndex];
  932.   NewStyle := esSimple;
  933.   case Column.ButtonStyle of
  934.    cbsEllipsis: NewStyle := esEllipsis;
  935.    cbsAuto:
  936.      if Assigned(Column.Field) then
  937.      with Column.Field do
  938.      begin
  939.        { Show the dropdown button only if the field is editable }
  940.        if FieldKind = fkLookup then
  941.        begin
  942.          MasterField := Dataset.FieldByName(KeyFields);
  943.          { Column.DefaultReadonly will always be True for a lookup field.
  944.            Test if Column.ReadOnly has been assigned a value of True }
  945.          if Assigned(MasterField) and MasterField.CanModify and
  946.            not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
  947.            with TCustomDBGrid(Grid) do
  948.              if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
  949.                NewStyle := esDataList
  950.        end
  951.        else
  952.        if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
  953.          not Column.Readonly then
  954.          NewStyle := esPickList;
  955.      end;
  956.   end;
  957.   EditStyle := NewStyle;
  958.   inherited UpdateContents;
  959. end;
  960.  
  961. procedure TDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
  962. begin
  963.   if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
  964.     CloseUp(False);
  965. end;
  966.  
  967. procedure TDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
  968. begin
  969.   StopTracking;
  970.   inherited;
  971. end;
  972.  
  973. procedure TDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
  974. begin
  975.   inherited;
  976.   CloseUp(False);
  977. end;
  978.  
  979. procedure TDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  980. begin
  981.   with Message do
  982.   if (FEditStyle <> esSimple) and
  983.     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
  984.     Exit;
  985.   inherited;
  986. end;
  987.  
  988. procedure TDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
  989. begin
  990.   PaintHandler(Message);
  991. end;
  992.  
  993. procedure TDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
  994. var
  995.   P: TPoint;
  996. begin
  997.   GetCursorPos(P);
  998.   if (FEditStyle <> esSimple) and
  999.     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), ScreenToClient(P)) then
  1000.     Windows.SetCursor(LoadCursor(0, idc_Arrow))
  1001.   else
  1002.     inherited;
  1003. end;
  1004.  
  1005. procedure TDBGridInplaceEdit.WndProc(var Message: TMessage);
  1006. begin
  1007.   case Message.Msg of
  1008.     wm_KeyDown, wm_SysKeyDown, wm_Char:
  1009.       if EditStyle in [esPickList, esDataList] then
  1010.       with TWMKey(Message) do
  1011.       begin
  1012.         DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
  1013.         if (CharCode <> 0) and FListVisible then
  1014.         begin
  1015.           with TMessage(Message) do
  1016.             SendMessage(FActiveList.Handle, Msg, WParam, LParam);
  1017.           Exit;
  1018.         end;
  1019.       end
  1020.   end;
  1021.   inherited;
  1022. end;
  1023.  
  1024.  
  1025. { TGridDataLink }
  1026.  
  1027. type
  1028.   TIntArray = array[0..MaxMapSize] of Integer;
  1029.   PIntArray = ^TIntArray;
  1030.  
  1031. constructor TGridDataLink.Create(AGrid: TCustomDBGrid);
  1032. begin
  1033.   inherited Create;
  1034.   FGrid := AGrid;
  1035. end;
  1036.  
  1037. destructor TGridDataLink.Destroy;
  1038. begin
  1039.   ClearMapping;
  1040.   inherited Destroy;
  1041. end;
  1042.  
  1043. function TGridDataLink.GetDefaultFields: Boolean;
  1044. var
  1045.   I: Integer;
  1046. begin
  1047.   Result := True;
  1048.   if DataSet <> nil then Result := DataSet.DefaultFields;
  1049.   if Result and SparseMap then
  1050.   for I := 0 to FFieldCount-1 do
  1051.     if PIntArray(FFieldMap)^[I] < 0 then
  1052.     begin
  1053.       Result := False;
  1054.       Exit;
  1055.     end;
  1056. end;
  1057.  
  1058. function TGridDataLink.GetFields(I: Integer): TField;
  1059. begin
  1060.   if (0 <= I) and (I < FFieldCount) and (PIntArray(FFieldMap)^[I] >= 0) then
  1061.     Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
  1062.   else
  1063.     Result := nil;
  1064. end;
  1065.  
  1066. function TGridDataLink.AddMapping(const FieldName: string): Boolean;
  1067. var
  1068.   Field: TField;
  1069.   NewSize: Integer;
  1070. begin
  1071.   Result := True;
  1072.   if FFieldCount >= MaxMapSize then RaiseGridError(STooManyColumns);
  1073.   if SparseMap then
  1074.     Field := DataSet.FindField(FieldName)
  1075.   else
  1076.     Field := DataSet.FieldByName(FieldName);
  1077.  
  1078.   if FFieldCount = FFieldMapSize then
  1079.   begin
  1080.     NewSize := FFieldMapSize;
  1081.     if NewSize = 0 then
  1082.       NewSize := 8
  1083.     else
  1084.       Inc(NewSize, NewSize);
  1085.     if (NewSize < FFieldCount) then
  1086.       NewSize := FFieldCount + 1;
  1087.     if (NewSize > MaxMapSize) then
  1088.       NewSize := MaxMapSize;
  1089.     ReallocMem(FFieldMap, NewSize * SizeOf(Integer));
  1090.     FFieldMapSize := NewSize;
  1091.   end;
  1092.   if Assigned(Field) then
  1093.   begin
  1094.     PIntArray(FFieldMap)^[FFieldCount] := Field.Index;
  1095.     Field.FreeNotification(FGrid);
  1096.   end
  1097.   else
  1098.     PIntArray(FFieldMap)^[FFieldCount] := -1;
  1099.   Inc(FFieldCount);
  1100. end;
  1101.  
  1102. procedure TGridDataLink.ActiveChanged;
  1103. begin
  1104.   FGrid.LinkActive(Active);
  1105. end;
  1106.  
  1107. procedure TGridDataLink.ClearMapping;
  1108. begin
  1109.   if FFieldMap <> nil then
  1110.   begin
  1111.     FreeMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
  1112.     FFieldMap := nil;
  1113.     FFieldMapSize := 0;
  1114.     FFieldCount := 0;
  1115.   end;
  1116. end;
  1117.  
  1118. procedure TGridDataLink.Modified;
  1119. begin
  1120.   FModified := True;
  1121. end;
  1122.  
  1123. procedure TGridDataLink.DataSetChanged;
  1124. begin
  1125.   FGrid.DataChanged;
  1126.   FModified := False;
  1127. end;
  1128.  
  1129. procedure TGridDataLink.DataSetScrolled(Distance: Integer);
  1130. begin
  1131.   FGrid.Scroll(Distance);
  1132. end;
  1133.  
  1134. procedure TGridDataLink.LayoutChanged;
  1135. var
  1136.   SaveState: Boolean;
  1137. begin
  1138.   { FLayoutFromDataset determines whether default column width is forced to
  1139.     be at least wide enough for the column title.  }
  1140.   SaveState := FGrid.FLayoutFromDataset;
  1141.   FGrid.FLayoutFromDataset := True;
  1142.   try
  1143.     FGrid.LayoutChanged;
  1144.   finally
  1145.     FGrid.FLayoutFromDataset := SaveState;
  1146.   end;
  1147. end;
  1148.  
  1149. procedure TGridDataLink.FocusControl(Field: TFieldRef);
  1150. begin
  1151.   if Assigned(Field) and Assigned(Field^) then
  1152.   begin
  1153.     FGrid.SelectedField := Field^;
  1154.     if (FGrid.SelectedField = Field^) and FGrid.AcquireFocus then
  1155.     begin
  1156.       Field^ := nil;
  1157.       FGrid.ShowEditor;
  1158.     end;
  1159.   end;
  1160. end;
  1161.  
  1162. procedure TGridDataLink.EditingChanged;
  1163. begin
  1164.   FGrid.EditingChanged;
  1165. end;
  1166.  
  1167. procedure TGridDataLink.RecordChanged(Field: TField);
  1168. begin
  1169.   FGrid.RecordChanged(Field);
  1170.   FModified := False;
  1171. end;
  1172.  
  1173. procedure TGridDataLink.UpdateData;
  1174. begin
  1175.   FInUpdateData := True;
  1176.   try
  1177.     if FModified then FGrid.UpdateData;
  1178.     FModified := False;
  1179.   finally
  1180.     FInUpdateData := False;
  1181.   end;
  1182. end;
  1183.  
  1184. function TGridDataLink.GetMappedIndex(ColIndex: Integer): Integer;
  1185. begin
  1186.   if (0 <= ColIndex) and (ColIndex < FFieldCount) then
  1187.     Result := PIntArray(FFieldMap)^[ColIndex]
  1188.   else
  1189.     Result := -1;
  1190. end;
  1191.  
  1192. procedure TGridDataLink.Reset;
  1193. begin
  1194.   if FModified then RecordChanged(nil) else Dataset.Cancel;
  1195. end;
  1196.  
  1197.  
  1198. { TColumnTitle }
  1199. constructor TColumnTitle.Create(Column: TColumn);
  1200. begin
  1201.   inherited Create;
  1202.   FColumn := Column;
  1203.   FFont := TFont.Create;
  1204.   FFont.Assign(DefaultFont);
  1205.   FFont.OnChange := FontChanged;
  1206. end;
  1207.  
  1208. destructor TColumnTitle.Destroy;
  1209. begin
  1210.   FFont.Free;
  1211.   inherited Destroy;
  1212. end;
  1213.  
  1214. procedure TColumnTitle.Assign(Source: TPersistent);
  1215. begin
  1216.   if Source is TColumnTitle then
  1217.   begin
  1218.     if cvTitleAlignment in TColumnTitle(Source).FColumn.FAssignedValues then
  1219.       Alignment := TColumnTitle(Source).Alignment;
  1220.     if cvTitleColor in TColumnTitle(Source).FColumn.FAssignedValues then
  1221.       Color := TColumnTitle(Source).Color;
  1222.     if cvTitleCaption in TColumnTitle(Source).FColumn.FAssignedValues then
  1223.       Caption := TColumnTitle(Source).Caption;
  1224.     if cvTitleFont in TColumnTitle(Source).FColumn.FAssignedValues then
  1225.       Font := TColumnTitle(Source).Font;
  1226.   end
  1227.   else
  1228.     inherited Assign(Source);
  1229. end;
  1230.  
  1231. function TColumnTitle.DefaultAlignment: TAlignment;
  1232. begin
  1233.   Result := taLeftJustify;
  1234. end;
  1235.  
  1236. function TColumnTitle.DefaultColor: TColor;
  1237. var
  1238.   Grid: TCustomDBGrid;
  1239. begin
  1240.   Grid := FColumn.GetGrid;
  1241.   if Assigned(Grid) then
  1242.     Result := Grid.FixedColor
  1243.   else
  1244.     Result := clBtnFace;
  1245. end;
  1246.  
  1247. function TColumnTitle.DefaultFont: TFont;
  1248. var
  1249.   Grid: TCustomDBGrid;
  1250. begin
  1251.   Grid := FColumn.GetGrid;
  1252.   if Assigned(Grid) then
  1253.     Result := Grid.TitleFont
  1254.   else
  1255.     Result := FColumn.Font;
  1256. end;
  1257.  
  1258. function TColumnTitle.DefaultCaption: string;
  1259. var
  1260.   Field: TField;
  1261. begin
  1262.   Field := FColumn.Field;
  1263.   if Assigned(Field) then
  1264.     Result := Field.DisplayName
  1265.   else
  1266.     Result := FColumn.FieldName;
  1267. end;
  1268.  
  1269. procedure TColumnTitle.FontChanged(Sender: TObject);
  1270. begin
  1271.   Include(FColumn.FAssignedValues, cvTitleFont);
  1272.   FColumn.Changed(True);
  1273. end;
  1274.  
  1275. function TColumnTitle.GetAlignment: TAlignment;
  1276. begin
  1277.   if cvTitleAlignment in FColumn.FAssignedValues then
  1278.     Result := FAlignment
  1279.   else
  1280.     Result := DefaultAlignment;
  1281. end;
  1282.  
  1283. function TColumnTitle.GetColor: TColor;
  1284. begin
  1285.   if cvTitleColor in FColumn.FAssignedValues then
  1286.     Result := FColor
  1287.   else
  1288.     Result := DefaultColor;
  1289. end;
  1290.  
  1291. function TColumnTitle.GetCaption: string;
  1292. begin
  1293.   if cvTitleCaption in FColumn.FAssignedValues then
  1294.     Result := FCaption
  1295.   else
  1296.     Result := DefaultCaption;
  1297. end;
  1298.  
  1299. function TColumnTitle.GetFont: TFont;
  1300. var
  1301.   Save: TNotifyEvent;
  1302.   Def: TFont;
  1303. begin
  1304.   if not (cvTitleFont in FColumn.FAssignedValues) then
  1305.   begin
  1306.     Def := DefaultFont;
  1307.     if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
  1308.     begin
  1309.       Save := FFont.OnChange;
  1310.       FFont.OnChange := nil;
  1311.       FFont.Assign(DefaultFont);
  1312.       FFont.OnChange := Save;
  1313.     end;
  1314.   end;
  1315.   Result := FFont;
  1316. end;
  1317.  
  1318. function TColumnTitle.IsAlignmentStored: Boolean;
  1319. begin
  1320.   Result := (cvTitleAlignment in FColumn.FAssignedValues) and
  1321.     (FAlignment <> DefaultAlignment);
  1322. end;
  1323.  
  1324. function TColumnTitle.IsColorStored: Boolean;
  1325. begin
  1326.   Result := (cvTitleColor in FColumn.FAssignedValues) and
  1327.     (FColor <> DefaultColor);
  1328. end;
  1329.  
  1330. function TColumnTitle.IsFontStored: Boolean;
  1331. begin
  1332.   Result := (cvTitleFont in FColumn.FAssignedValues);
  1333. end;
  1334.  
  1335. function TColumnTitle.IsCaptionStored: Boolean;
  1336. begin
  1337.   Result := (cvTitleCaption in FColumn.FAssignedValues) and
  1338.     (FCaption <> DefaultCaption);
  1339. end;
  1340.  
  1341. procedure TColumnTitle.RefreshDefaultFont;
  1342. var
  1343.   Save: TNotifyEvent;
  1344. begin
  1345.   if (cvTitleFont in FColumn.FAssignedValues) then Exit;
  1346.   Save := FFont.OnChange;
  1347.   FFont.OnChange := nil;
  1348.   try
  1349.     FFont.Assign(DefaultFont);
  1350.   finally
  1351.     FFont.OnChange := Save;
  1352.   end;
  1353. end;
  1354.  
  1355. procedure TColumnTitle.RestoreDefaults;
  1356. var
  1357.   FontAssigned: Boolean;
  1358. begin
  1359.   FontAssigned := cvTitleFont in FColumn.FAssignedValues;
  1360.   FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
  1361.   FCaption := '';
  1362.   RefreshDefaultFont;
  1363.   { If font was assigned, changing it back to default may affect grid title
  1364.     height, and title height changes require layout and redraw of the grid. }
  1365.   FColumn.Changed(FontAssigned);
  1366. end;
  1367.  
  1368. procedure TColumnTitle.SetAlignment(Value: TAlignment);
  1369. begin
  1370.   if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
  1371.   FAlignment := Value;
  1372.   Include(FColumn.FAssignedValues, cvTitleAlignment);
  1373.   FColumn.Changed(False);
  1374. end;
  1375.  
  1376. procedure TColumnTitle.SetColor(Value: TColor);
  1377. begin
  1378.   if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
  1379.   FColor := Value;
  1380.   Include(FColumn.FAssignedValues, cvTitleColor);
  1381.   FColumn.Changed(False);
  1382. end;
  1383.  
  1384. procedure TColumnTitle.SetFont(Value: TFont);
  1385. begin
  1386.   FFont.Assign(Value);
  1387. end;
  1388.  
  1389. procedure TColumnTitle.SetCaption(const Value: string);
  1390. begin
  1391.   if (cvTitleCaption in FColumn.FAssignedValues) and (Value = FCaption) then Exit;
  1392.   FCaption := Value;
  1393.   Include(FColumn.FAssignedValues, cvTitleCaption);
  1394.   FColumn.Changed(False);
  1395. end;
  1396.  
  1397.  
  1398. { TColumn }
  1399.  
  1400. constructor TColumn.Create(Collection: TCollection);
  1401. var
  1402.   Grid: TCustomDBGrid;
  1403. begin
  1404.   Grid := nil;
  1405.   if Assigned(Collection) and (Collection is TDBGridColumns) then
  1406.     Grid := TDBGridColumns(Collection).Grid;
  1407.   if Assigned(Grid) then
  1408.     Grid.BeginLayout;
  1409.   try
  1410.     inherited Create(Collection);
  1411.     FDropDownRows := 7;
  1412.     FButtonStyle := cbsAuto;
  1413.     FFont := TFont.Create;
  1414.     FFont.Assign(DefaultFont);
  1415.     FFont.OnChange := FontChanged;
  1416.     FTitle := CreateTitle;
  1417.   finally
  1418.     if Assigned(Grid) then
  1419.       Grid.EndLayout;
  1420.   end;
  1421. end;
  1422.  
  1423. destructor TColumn.Destroy;
  1424. begin
  1425.   FTitle.Free;
  1426.   FFont.Free;
  1427.   FPickList.Free;
  1428.   inherited Destroy;
  1429. end;
  1430.  
  1431. procedure TColumn.Assign(Source: TPersistent);
  1432. begin
  1433.   if Source is TColumn then
  1434.   begin
  1435.     if Assigned(Collection) then Collection.BeginUpdate;
  1436.     try
  1437.       RestoreDefaults;
  1438.       FieldName := TColumn(Source).FieldName;
  1439.       if cvColor in TColumn(Source).AssignedValues then
  1440.         Color := TColumn(Source).Color;
  1441.       if cvWidth in TColumn(Source).AssignedValues then
  1442.         Width := TColumn(Source).Width;
  1443.       if cvFont in TColumn(Source).AssignedValues then
  1444.         Font := TColumn(Source).Font;
  1445.       if cvAlignment in TColumn(Source).AssignedValues then
  1446.         Alignment := TColumn(Source).Alignment;
  1447.       if cvReadOnly in TColumn(Source).AssignedValues then
  1448.         ReadOnly := TColumn(Source).ReadOnly;
  1449.       Title := TColumn(Source).Title;
  1450.       DropDownRows := TColumn(Source).DropDownRows;
  1451.       ButtonStyle := TColumn(Source).ButtonStyle;
  1452.       PickList := TColumn(Source).PickList;
  1453.       PopupMenu := TColumn(Source).PopupMenu;
  1454.     finally
  1455.       if Assigned(Collection) then Collection.EndUpdate;
  1456.     end;
  1457.   end
  1458.   else
  1459.     inherited Assign(Source);
  1460. end;
  1461.  
  1462. function TColumn.CreateTitle: TColumnTitle;
  1463. begin
  1464.   Result := TColumnTitle.Create(Self);
  1465. end;
  1466.  
  1467. function TColumn.DefaultAlignment: TAlignment;
  1468. begin
  1469.   if Assigned(Field) then
  1470.     Result := FField.Alignment
  1471.   else
  1472.     Result := taLeftJustify;
  1473. end;
  1474.  
  1475. function TColumn.DefaultColor: TColor;
  1476. var
  1477.   Grid: TCustomDBGrid;
  1478. begin
  1479.   Grid := GetGrid;
  1480.   if Assigned(Grid) then
  1481.     Result := Grid.Color
  1482.   else
  1483.     Result := clWindow;
  1484. end;
  1485.  
  1486. function TColumn.DefaultFont: TFont;
  1487. var
  1488.   Grid: TCustomDBGrid;
  1489. begin
  1490.   Grid := GetGrid;
  1491.   if Assigned(Grid) then
  1492.     Result := Grid.Font
  1493.   else
  1494.     Result := FFont;
  1495. end;
  1496.  
  1497. function TColumn.DefaultReadOnly: Boolean;
  1498. var
  1499.   Grid: TCustomDBGrid;
  1500. begin
  1501.   Grid := GetGrid;
  1502.   Result := (Assigned(Grid) and Grid.ReadOnly) or (Assigned(Field) and FField.ReadOnly);
  1503. end;
  1504.  
  1505. function TColumn.DefaultWidth: Integer;
  1506. var
  1507.   W: Integer;
  1508.   RestoreCanvas: Boolean;
  1509.   TM: TTextMetric;
  1510. begin
  1511.   if GetGrid = nil then
  1512.   begin
  1513.     Result := 64;
  1514.     Exit;
  1515.   end;
  1516.   with GetGrid do
  1517.   begin
  1518.     if Assigned(Field) then
  1519.     begin
  1520.       RestoreCanvas := not HandleAllocated;
  1521.       if RestoreCanvas then
  1522.         Canvas.Handle := GetDC(0);
  1523.       try
  1524.         Canvas.Font := Self.Font;
  1525.         GetTextMetrics(Canvas.Handle, TM);
  1526.         Result := Field.DisplayWidth * (Canvas.TextWidth('0') - TM.tmOverhang)
  1527.           + TM.tmOverhang + 4;
  1528.         if dgTitles in Options then
  1529.         begin
  1530.           Canvas.Font := Title.Font;
  1531.           W := Canvas.TextWidth(Title.Caption) + 4;
  1532.           if Result < W then
  1533.             Result := W;
  1534.         end;
  1535.       finally
  1536.         if RestoreCanvas then
  1537.         begin
  1538.           ReleaseDC(0,Canvas.Handle);
  1539.           Canvas.Handle := 0;
  1540.         end;
  1541.       end;
  1542.     end
  1543.     else
  1544.       Result := DefaultColWidth;
  1545.   end;
  1546. end;
  1547.  
  1548. procedure TColumn.FontChanged;
  1549. begin
  1550.   Include(FAssignedValues, cvFont);
  1551.   Title.RefreshDefaultFont;
  1552.   Changed(False);
  1553. end;
  1554.  
  1555. function TColumn.GetAlignment: TAlignment;
  1556. begin
  1557.   if cvAlignment in FAssignedValues then
  1558.     Result := FAlignment
  1559.   else
  1560.     Result := DefaultAlignment;
  1561. end;
  1562.  
  1563. function TColumn.GetColor: TColor;
  1564. begin
  1565.   if cvColor in FAssignedValues then
  1566.     Result := FColor
  1567.   else
  1568.     Result := DefaultColor;
  1569. end;
  1570.  
  1571. function TColumn.GetField: TField;
  1572. var
  1573.   Grid: TCustomDBGrid;
  1574. begin    { Returns Nil if FieldName can't be found in dataset }
  1575.   Grid := GetGrid;
  1576.   if (FField = nil) and (Length(FFieldName) > 0) and Assigned(Grid) and
  1577.     Assigned(Grid.DataLink.DataSet) then
  1578.   with Grid.Datalink.Dataset do
  1579.     if Active or (not DefaultFields) then
  1580.       SetField(FindField(FieldName));
  1581.   Result := FField;
  1582. end;
  1583.  
  1584. function TColumn.GetFont: TFont;
  1585. var
  1586.   Save: TNotifyEvent;
  1587. begin
  1588.   if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
  1589.   begin
  1590.     Save := FFont.OnChange;
  1591.     FFont.OnChange := nil;
  1592.     FFont.Assign(DefaultFont);
  1593.     FFont.OnChange := Save;
  1594.   end;
  1595.   Result := FFont;
  1596. end;
  1597.  
  1598. function TColumn.GetGrid: TCustomDBGrid;
  1599. begin
  1600.   if Assigned(Collection) and (Collection is TDBGridColumns) then
  1601.     Result := TDBGridColumns(Collection).Grid
  1602.   else
  1603.     Result := nil;
  1604. end;
  1605.  
  1606. function TColumn.GetDisplayName: string;
  1607. begin
  1608.   Result := FFieldName;
  1609.   if Result = '' then Result := inherited GetDisplayName;
  1610. end;
  1611.  
  1612. function TColumn.GetPickList: TStrings;
  1613. begin
  1614.   if FPickList = nil then
  1615.     FPickList := TStringList.Create;
  1616.   Result := FPickList;
  1617. end;
  1618.  
  1619. function TColumn.GetReadOnly: Boolean;
  1620. begin
  1621.   if cvReadOnly in FAssignedValues then
  1622.     Result := FReadOnly
  1623.   else
  1624.     Result := DefaultReadOnly;
  1625. end;
  1626.  
  1627. function TColumn.GetWidth: Integer;
  1628. begin
  1629.   if cvWidth in FAssignedValues then
  1630.     Result := FWidth
  1631.   else
  1632.     Result := DefaultWidth;
  1633. end;
  1634.  
  1635. function TColumn.IsAlignmentStored: Boolean;
  1636. begin
  1637.   Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
  1638. end;
  1639.  
  1640. function TColumn.IsColorStored: Boolean;
  1641. begin
  1642.   Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
  1643. end;
  1644.  
  1645. function TColumn.IsFontStored: Boolean;
  1646. begin
  1647.   Result := (cvFont in FAssignedValues);
  1648. end;
  1649.  
  1650. function TColumn.IsReadOnlyStored: Boolean;
  1651. begin
  1652.   Result := (cvReadOnly in FAssignedValues) and (FReadOnly <> DefaultReadOnly);
  1653. end;
  1654.  
  1655. function TColumn.IsWidthStored: Boolean;
  1656. begin
  1657.   Result := (cvWidth in FAssignedValues) and (FWidth <> DefaultWidth);
  1658. end;
  1659.  
  1660. procedure TColumn.RefreshDefaultFont;
  1661. var
  1662.   Save: TNotifyEvent;
  1663. begin
  1664.   if cvFont in FAssignedValues then Exit;
  1665.   Save := FFont.OnChange;
  1666.   FFont.OnChange := nil;
  1667.   try
  1668.     FFont.Assign(DefaultFont);
  1669.   finally
  1670.     FFont.OnChange := Save;
  1671.   end;
  1672. end;
  1673.  
  1674. procedure TColumn.RestoreDefaults;
  1675. var
  1676.   FontAssigned: Boolean;
  1677. begin
  1678.   FontAssigned := cvFont in FAssignedValues;
  1679.   FTitle.RestoreDefaults;
  1680.   FAssignedValues := [];
  1681.   RefreshDefaultFont;
  1682.   FPickList.Free;
  1683.   FPickList := nil;
  1684.   ButtonStyle := cbsAuto;
  1685.   Changed(FontAssigned);
  1686. end;
  1687.  
  1688. procedure TColumn.SetAlignment(Value: TAlignment);
  1689. begin
  1690.   if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
  1691.   FAlignment := Value;
  1692.   Include(FAssignedValues, cvAlignment);
  1693.   Changed(False);
  1694. end;
  1695.  
  1696. procedure TColumn.SetButtonStyle(Value: TColumnButtonStyle);
  1697. begin
  1698.   if Value = FButtonStyle then Exit;
  1699.   FButtonStyle := Value;
  1700.   Changed(False);
  1701. end;
  1702.  
  1703. procedure TColumn.SetColor(Value: TColor);
  1704. begin
  1705.   if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
  1706.   FColor := Value;
  1707.   Include(FAssignedValues, cvColor);
  1708.   Changed(False);
  1709. end;
  1710.  
  1711. procedure TColumn.SetField(Value: TField);
  1712. begin
  1713.   if FField = Value then Exit;
  1714.   FField := Value;
  1715.   if Assigned(Value) then
  1716.     FFieldName := Value.FieldName;
  1717.   Changed(False);
  1718. end;
  1719.  
  1720. procedure TColumn.SetFieldName(const Value: String);
  1721. var
  1722.   AField: TField;
  1723.   Grid: TCustomDBGrid;
  1724. begin
  1725.   AField := nil;
  1726.   Grid := GetGrid;
  1727.   if Assigned(Grid) and Assigned(Grid.DataLink.DataSet) and
  1728.     not (csLoading in Grid.ComponentState) and (Length(Value) > 0) then
  1729.       AField := Grid.DataLink.DataSet.FindField(Value); { no exceptions }
  1730.   FFieldName := Value;
  1731.   SetField(AField);
  1732.   Changed(False);
  1733. end;
  1734.  
  1735. procedure TColumn.SetFont(Value: TFont);
  1736. begin
  1737.   FFont.Assign(Value);
  1738.   Include(FAssignedValues, cvFont);
  1739.   Changed(False);
  1740. end;
  1741.  
  1742. procedure TColumn.SetPickList(Value: TStrings);
  1743. begin
  1744.   if Value = nil then
  1745.   begin
  1746.     FPickList.Free;
  1747.     FPickList := nil;
  1748.     Exit;
  1749.   end;
  1750.   PickList.Assign(Value);
  1751. end;
  1752.  
  1753. procedure TColumn.SetPopupMenu(Value: TPopupMenu);
  1754. begin
  1755.   FPopupMenu := Value;
  1756.   if Value <> nil then Value.FreeNotification(GetGrid);
  1757. end;
  1758.  
  1759. procedure TColumn.SetReadOnly(Value: Boolean);
  1760. begin
  1761.   if (cvReadOnly in FAssignedValues) and (Value = FReadOnly) then Exit;
  1762.   FReadOnly := Value;
  1763.   Include(FAssignedValues, cvReadOnly);
  1764.   Changed(False);
  1765. end;
  1766.  
  1767. procedure TColumn.SetTitle(Value: TColumnTitle);
  1768. begin
  1769.   FTitle.Assign(Value);
  1770. end;
  1771.  
  1772. procedure TColumn.SetWidth(Value: Integer);
  1773. begin
  1774.   if (cvWidth in FAssignedValues) or (Value <> DefaultWidth) then
  1775.   begin
  1776.     FWidth := Value;
  1777.     Include(FAssignedValues, cvWidth);
  1778.   end;
  1779.   Changed(False);
  1780. end;
  1781.  
  1782. { TPassthroughColumn }
  1783.  
  1784. type
  1785.   TPassthroughColumnTitle = class(TColumnTitle)
  1786.   private
  1787.     procedure SetCaption(const Value: string); override;
  1788.   end;
  1789.  
  1790.   TPassthroughColumn = class(TColumn)
  1791.   private
  1792.     procedure SetAlignment(Value: TAlignment); override;
  1793.     procedure SetField(Value: TField); override;
  1794.     procedure SetIndex(Value: Integer); override;
  1795.     procedure SetReadOnly(Value: Boolean); override;
  1796.     procedure SetWidth(Value: Integer); override;
  1797.   protected
  1798.     function CreateTitle: TColumnTitle; override;
  1799.   end;
  1800.  
  1801. { TPassthroughColumnTitle }
  1802.  
  1803. procedure TPassthroughColumnTitle.SetCaption(const Value: string);
  1804. var
  1805.   Grid: TCustomDBGrid;
  1806. begin
  1807.   Grid := FColumn.GetGrid;
  1808.   if Assigned(Grid) and (Grid.Datalink.Active) and Assigned(FColumn.Field) then
  1809.     FColumn.Field.DisplayLabel := Value
  1810.   else
  1811.     inherited SetCaption(Value);
  1812. end;
  1813.  
  1814.  
  1815. { TPassthroughColumn }
  1816.  
  1817. function TPassthroughColumn.CreateTitle: TColumnTitle;
  1818. begin
  1819.   Result := TPassthroughColumnTitle.Create(Self);
  1820. end;
  1821.  
  1822. procedure TPassthroughColumn.SetAlignment(Value: TAlignment);
  1823. var
  1824.   Grid: TCustomDBGrid;
  1825. begin
  1826.   Grid := GetGrid;
  1827.   if Assigned(Grid) and (Grid.Datalink.Active) and Assigned(Field) then
  1828.     Field.Alignment := Value
  1829.   else
  1830.     inherited SetAlignment(Value);
  1831. end;
  1832.  
  1833. procedure TPassthroughColumn.SetField(Value: TField);
  1834. begin
  1835.   inherited SetField(Value);
  1836.   if Value = nil then
  1837.     FFieldName := '';
  1838.   RestoreDefaults;
  1839. end;
  1840.  
  1841. procedure TPassthroughColumn.SetIndex(Value: Integer);
  1842. var
  1843.   Grid: TCustomDBGrid;
  1844.   Fld: TField;
  1845. begin
  1846.   Grid := GetGrid;
  1847.   if Assigned(Grid) and Grid.Datalink.Active then
  1848.   begin
  1849.     Fld := Grid.Datalink.Fields[Value];
  1850.     if Assigned(Fld) then
  1851.       Field.Index := Fld.Index;
  1852.   end;
  1853.   inherited SetIndex(Value);
  1854. end;
  1855.  
  1856. procedure TPassthroughColumn.SetReadOnly(Value: Boolean);
  1857. var
  1858.   Grid: TCustomDBGrid;
  1859. begin
  1860.   Grid := GetGrid;
  1861.   if Assigned(Grid) and Grid.Datalink.Active and Assigned(Field) then
  1862.     Field.ReadOnly := Value
  1863.   else
  1864.     inherited SetReadOnly(Value);
  1865. end;
  1866.  
  1867. procedure TPassthroughColumn.SetWidth(Value: Integer);
  1868. var
  1869.   Grid: TCustomDBGrid;
  1870.   TM: TTextMetric;
  1871. begin
  1872.   Grid := GetGrid;
  1873.   if Assigned(Grid) then
  1874.   begin
  1875.     if Grid.HandleAllocated and Assigned(Field) and Grid.FUpdateFields then
  1876.     with Grid do
  1877.     begin
  1878.       Canvas.Font := Self.Font;
  1879.       GetTextMetrics(Canvas.Handle, TM);
  1880.       Field.DisplayWidth := (Value + (TM.tmAveCharWidth div 2) - TM.tmOverhang - 3)
  1881.         div TM.tmAveCharWidth;
  1882.     end;
  1883.     if (not Grid.FLayoutFromDataset) or (cvWidth in FAssignedValues) then
  1884.       inherited SetWidth(Value);
  1885.   end
  1886.   else
  1887.     inherited SetWidth(Value);
  1888. end;
  1889.  
  1890.  
  1891. { TDBGridColumns }
  1892.  
  1893. constructor TDBGridColumns.Create(Grid: TCustomDBGrid; ColumnClass: TColumnClass);
  1894. begin
  1895.   inherited Create(ColumnClass);
  1896.   FGrid := Grid;
  1897. end;
  1898.  
  1899. function TDBGridColumns.Add: TColumn;
  1900. begin
  1901.   Result := TColumn(inherited Add);
  1902. end;
  1903.  
  1904. function TDBGridColumns.GetColumn(Index: Integer): TColumn;
  1905. begin
  1906.   Result := TColumn(inherited Items[Index]);
  1907. end;
  1908.  
  1909. function TDBGridColumns.GetOwner: TPersistent;
  1910. begin
  1911.   Result := FGrid;
  1912. end;
  1913.  
  1914. function TDBGridColumns.GetState: TDBGridColumnsState;
  1915. begin
  1916.   Result := TDBGridColumnsState((Count > 0) and not (Items[0] is TPassthroughColumn));
  1917. end;
  1918.  
  1919. procedure TDBGridColumns.LoadFromFile(const Filename: string);
  1920. var
  1921.   S: TFileStream;
  1922. begin
  1923.   S := TFileStream.Create(Filename, fmOpenRead);
  1924.   try
  1925.     LoadFromStream(S);
  1926.   finally
  1927.     S.Free;
  1928.   end;
  1929. end;
  1930.  
  1931. type
  1932.   TColumnsWrapper = class(TComponent)
  1933.   private
  1934.     FColumns: TDBGridColumns;
  1935.   published
  1936.     property Columns: TDBGridColumns read FColumns write FColumns;
  1937.   end;
  1938.  
  1939. procedure TDBGridColumns.LoadFromStream(S: TStream);
  1940. var
  1941.   Wrapper: TColumnsWrapper;
  1942. begin
  1943.   Wrapper := TColumnsWrapper.Create(nil);
  1944.   try
  1945.     Wrapper.Columns := FGrid.CreateColumns;
  1946.     S.ReadComponent(Wrapper);
  1947.     Assign(Wrapper.Columns);
  1948.   finally
  1949.     Wrapper.Columns.Free;
  1950.     Wrapper.Free;
  1951.   end;
  1952. end;
  1953.  
  1954. procedure TDBGridColumns.RestoreDefaults;
  1955. var
  1956.   I: Integer;
  1957. begin
  1958.   BeginUpdate;
  1959.   try
  1960.     for I := 0 to Count-1 do
  1961.       Items[I].RestoreDefaults;
  1962.   finally
  1963.     EndUpdate;
  1964.   end;
  1965. end;
  1966.  
  1967. procedure TDBGridColumns.RebuildColumns;
  1968. var
  1969.   I: Integer;
  1970. begin
  1971.   if Assigned(FGrid) and Assigned(FGrid.DataSource) and
  1972.     Assigned(FGrid.Datasource.Dataset) then
  1973.   begin
  1974.     FGrid.BeginLayout;
  1975.     try
  1976.       Clear;
  1977.       with FGrid.Datasource.Dataset do
  1978.         for I := 0 to FieldCount-1 do
  1979.           Add.FieldName := Fields[I].FieldName
  1980.     finally
  1981.       FGrid.EndLayout;
  1982.     end
  1983.   end
  1984.   else
  1985.     Clear;
  1986. end;
  1987.  
  1988. procedure TDBGridColumns.SaveToFile(const Filename: string);
  1989. var
  1990.   S: TStream;
  1991. begin
  1992.   S := TFileStream.Create(Filename, fmCreate);
  1993.   try
  1994.     SaveToStream(S);
  1995.   finally
  1996.     S.Free;
  1997.   end;
  1998. end;
  1999.  
  2000. procedure TDBGridColumns.SaveToStream(S: TStream);
  2001. var
  2002.   Wrapper: TColumnsWrapper;
  2003. begin
  2004.   Wrapper := TColumnsWrapper.Create(nil);
  2005.   try
  2006.     Wrapper.Columns := Self;
  2007.     S.WriteComponent(Wrapper);
  2008.   finally
  2009.     Wrapper.Free;
  2010.   end;
  2011. end;
  2012.  
  2013. procedure TDBGridColumns.SetColumn(Index: Integer; Value: TColumn);
  2014. begin
  2015.   Items[Index].Assign(Value);
  2016. end;
  2017.  
  2018. procedure TDBGridColumns.SetState(NewState: TDBGridColumnsState);
  2019. begin
  2020.   if NewState = State then Exit;
  2021.   if NewState = csDefault then
  2022.     Clear
  2023.   else
  2024.     RebuildColumns;
  2025. end;
  2026.  
  2027. procedure TDBGridColumns.Update(Item: TCollectionItem);
  2028. var
  2029.   Raw: Integer;
  2030. begin
  2031.   if (FGrid = nil) or (csLoading in FGrid.ComponentState) then Exit;
  2032.   if Item = nil then
  2033.   begin
  2034.     FGrid.LayoutChanged;
  2035.   end
  2036.   else
  2037.   begin
  2038.     Raw := FGrid.DataToRawColumn(Item.Index);
  2039.     FGrid.InvalidateCol(Raw);
  2040.     FGrid.ColWidths[Raw] := TColumn(Item).Width;
  2041.   end;
  2042. end;
  2043.  
  2044. { TBookmarkList }
  2045.  
  2046. constructor TBookmarkList.Create(AGrid: TCustomDBGrid);
  2047. begin
  2048.   inherited Create;
  2049.   FList := TStringList.Create;
  2050.   FList.OnChange := StringsChanged;
  2051.   FGrid := AGrid;
  2052. end;
  2053.  
  2054. destructor TBookmarkList.Destroy;
  2055. begin
  2056.   Clear;
  2057.   FList.Free;
  2058.   inherited Destroy;
  2059. end;
  2060.  
  2061. procedure TBookmarkList.Clear;
  2062. begin
  2063.   if FList.Count = 0 then Exit;
  2064.   FList.Clear;
  2065.   FGrid.Invalidate;
  2066. end;
  2067.  
  2068. function TBookmarkList.Compare(const Item1, Item2: TBookmarkStr): Integer;
  2069. begin
  2070.   with FGrid.Datalink.Datasource.Dataset do
  2071.     Result := CompareBookmarks(TBookmark(Item1), TBookmark(Item2));
  2072. end;
  2073.  
  2074. function TBookmarkList.CurrentRow: TBookmarkStr;
  2075. begin
  2076.   if not FLinkActive then RaiseGridError(sDataSetClosed);
  2077.   Result := FGrid.Datalink.Datasource.Dataset.Bookmark;
  2078. end;
  2079.  
  2080. function TBookmarkList.GetCurrentRowSelected: Boolean;
  2081. var
  2082.   Index: Integer;
  2083. begin
  2084.   Result := Find(CurrentRow, Index);
  2085. end;
  2086.  
  2087. function TBookmarkList.Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
  2088. var
  2089.   L, H, I, C: Integer;
  2090. begin
  2091.   if (Item = FCache) and (FCacheIndex >= 0) then
  2092.   begin
  2093.     Index := FCacheIndex;
  2094.     Result := FCacheFind;
  2095.     Exit;
  2096.   end;
  2097.   Result := False;
  2098.   L := 0;
  2099.   H := FList.Count - 1;
  2100.   while L <= H do
  2101.   begin
  2102.     I := (L + H) shr 1;
  2103.     C := Compare(FList[I], Item);
  2104.     if C < 0 then L := I + 1 else
  2105.     begin
  2106.       H := I - 1;
  2107.       if C = 0 then
  2108.       begin
  2109.         Result := True;
  2110.         L := I;
  2111.       end;
  2112.     end;
  2113.   end;
  2114.   Index := L;
  2115.   FCache := Item;
  2116.   FCacheIndex := Index;
  2117.   FCacheFind := Result;
  2118. end;
  2119.  
  2120. function TBookmarkList.GetCount: Integer;
  2121. begin
  2122.   Result := FList.Count;
  2123. end;
  2124.  
  2125. function TBookmarkList.GetItem(Index: Integer): TBookmarkStr;
  2126. begin
  2127.   Result := FList[Index];
  2128. end;
  2129.  
  2130. function TBookmarkList.IndexOf(const Item: TBookmarkStr): Integer;
  2131. begin
  2132.   if not Find(Item, Result) then
  2133.     Result := -1;
  2134. end;
  2135.  
  2136. procedure TBookmarkList.LinkActive(Value: Boolean);
  2137. begin
  2138.   Clear;
  2139.   FLinkActive := Value;
  2140. end;
  2141.  
  2142. procedure TBookmarkList.Delete;
  2143. var
  2144.   I: Integer;
  2145. begin
  2146.   with FGrid.Datalink.Datasource.Dataset do
  2147.   begin
  2148.     DisableControls;
  2149.     try
  2150.       for I := FList.Count-1 downto 0 do
  2151.       begin
  2152.         Bookmark := FList[I];
  2153.         Delete;
  2154.         FList.Delete(I);
  2155.       end;
  2156.     finally
  2157.       EnableControls;
  2158.     end;
  2159.   end;
  2160. end;
  2161.  
  2162. function TBookmarkList.Refresh: Boolean;
  2163. var
  2164.   I: Integer;
  2165. begin
  2166.   Result := False;
  2167.   with FGrid.DataLink.Datasource.Dataset do
  2168.   try
  2169.     CheckBrowseMode;
  2170.     for I := FList.Count - 1 downto 0 do
  2171.       if not BookmarkValid(TBookmark(FList[I])) then
  2172.       begin
  2173.         Result := True;
  2174.         FList.Delete(I);
  2175.       end;
  2176.   finally
  2177.     UpdateCursorPos;
  2178.     if Result then FGrid.Invalidate;
  2179.   end;
  2180. end;
  2181.  
  2182. procedure TBookmarkList.SetCurrentRowSelected(Value: Boolean);
  2183. var
  2184.   Index: Integer;
  2185.   Current: TBookmarkStr;
  2186. begin
  2187.   Current := CurrentRow;
  2188.   if (Length(Current) = 0) or (Find(Current, Index) = Value) then Exit;
  2189.   if Value then
  2190.     FList.Insert(Index, Current)
  2191.   else
  2192.     FList.Delete(Index);
  2193.   FGrid.InvalidateRow(FGrid.Row);
  2194. end;
  2195.  
  2196. procedure TBookmarkList.StringsChanged(Sender: TObject);
  2197. begin
  2198.   FCache := '';
  2199.   FCacheIndex := -1;
  2200. end;
  2201.  
  2202.  
  2203. { TCustomDBGrid }
  2204.  
  2205. var
  2206.   DrawBitmap: TBitmap;
  2207.   UserCount: Integer;
  2208.  
  2209. procedure UsesBitmap;
  2210. begin
  2211.   if UserCount = 0 then
  2212.     DrawBitmap := TBitmap.Create;
  2213.   Inc(UserCount);
  2214. end;
  2215.  
  2216. procedure ReleaseBitmap;
  2217. begin
  2218.   Dec(UserCount);
  2219.   if UserCount = 0 then DrawBitmap.Free;
  2220. end;
  2221.  
  2222. function Max(X, Y: Integer): Integer;
  2223. begin
  2224.   Result := Y;
  2225.   if X > Y then Result := X;
  2226. end;
  2227.  
  2228. procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  2229.   const Text: string; Alignment: TAlignment);
  2230. const
  2231.   AlignFlags : array [TAlignment] of Integer =
  2232.     ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
  2233.       DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
  2234.       DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
  2235. var
  2236.   B, R: TRect;
  2237.   I, Left: Integer;
  2238. begin
  2239.   I := ColorToRGB(ACanvas.Brush.Color);
  2240.   if GetNearestColor(ACanvas.Handle, I) = I then
  2241.   begin                       { Use ExtTextOut for solid colors }
  2242.     case Alignment of
  2243.       taLeftJustify:
  2244.         Left := ARect.Left + DX;
  2245.       taRightJustify:
  2246.         Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
  2247.     else { taCenter }
  2248.       Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
  2249.         - (ACanvas.TextWidth(Text) shr 1);
  2250.     end;
  2251.     ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
  2252.       ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
  2253.   end
  2254.   else begin                  { Use FillRect and Drawtext for dithered colors }
  2255.     DrawBitmap.Canvas.Lock;
  2256.     try
  2257.       with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
  2258.       begin                     { brush origin tics in painting / scrolling.    }
  2259.         Width := Max(Width, Right - Left);
  2260.         Height := Max(Height, Bottom - Top);
  2261.         R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
  2262.         B := Rect(0, 0, Right - Left, Bottom - Top);
  2263.       end;
  2264.       with DrawBitmap.Canvas do
  2265.       begin
  2266.         Font := ACanvas.Font;
  2267.         Font.Color := ACanvas.Font.Color;
  2268.         Brush := ACanvas.Brush;
  2269.         Brush.Style := bsSolid;
  2270.         FillRect(B);
  2271.         SetBkMode(Handle, TRANSPARENT);
  2272.         DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
  2273.       end;
  2274.       ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
  2275.     finally
  2276.       DrawBitmap.Canvas.Unlock;
  2277.     end;
  2278.   end;
  2279. end;
  2280.  
  2281. constructor TCustomDBGrid.Create(AOwner: TComponent);
  2282. var
  2283.   Bmp: TBitmap;
  2284. begin
  2285.   inherited Create(AOwner);
  2286.   inherited DefaultDrawing := False;
  2287.   FAcquireFocus := True;
  2288.   Bmp := TBitmap.Create;
  2289.   try
  2290.     Bmp.LoadFromResourceName(HInstance, bmArrow);
  2291.     FIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
  2292.     FIndicators.AddMasked(Bmp, clWhite);
  2293.     Bmp.LoadFromResourceName(HInstance, bmEdit);
  2294.     FIndicators.AddMasked(Bmp, clWhite);
  2295.     Bmp.LoadFromResourceName(HInstance, bmInsert);
  2296.     FIndicators.AddMasked(Bmp, clWhite);
  2297.   finally
  2298.     Bmp.Free;
  2299.   end;
  2300.   FTitleOffset := 1;
  2301.   FIndicatorOffset := 1;
  2302.   FUpdateFields := True;
  2303.   FOptions := [dgEditing, dgTitles, dgIndicator, dgColumnResize,
  2304.     dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
  2305.   DesignOptionsBoost := [goColSizing];
  2306.   UsesBitmap;
  2307.   ScrollBars := ssHorizontal;
  2308.   inherited Options := [goFixedHorzLine, goFixedVertLine, goHorzLine,
  2309.     goVertLine, goColSizing, goColMoving, goTabs, goEditing];
  2310.   FColumns := CreateColumns;
  2311.   inherited RowCount := 2;
  2312.   inherited ColCount := 2;
  2313.   FDataLink := TGridDataLink.Create(Self);
  2314.   Color := clWindow;
  2315.   ParentColor := False;
  2316.   FTitleFont := TFont.Create;
  2317.   FTitleFont.OnChange := TitleFontChanged;
  2318.   FSaveCellExtents := False;
  2319.   FUserChange := True;
  2320.   FDefaultDrawing := True;
  2321.   FBookmarks := TBookmarkList.Create(Self);
  2322.   HideEditor;
  2323. end;
  2324.  
  2325. destructor TCustomDBGrid.Destroy;
  2326. begin
  2327.   FColumns.Free;
  2328.   FColumns := nil;
  2329.   FDataLink.Free;
  2330.   FDataLink := nil;
  2331.   FIndicators.Free;
  2332.   FTitleFont.Free;
  2333.   FTitleFont := nil;
  2334.   FBookmarks.Free;
  2335.   FBookmarks := nil;
  2336.   inherited Destroy;
  2337.   ReleaseBitmap;
  2338. end;
  2339.  
  2340. function TCustomDBGrid.AcquireFocus: Boolean;
  2341. begin
  2342.   Result := True;
  2343.   if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
  2344.   begin
  2345.     SetFocus;
  2346.     Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
  2347.   end;
  2348. end;
  2349.  
  2350. function TCustomDBGrid.RawToDataColumn(ACol: Integer): Integer;
  2351. begin
  2352.   Result := ACol - FIndicatorOffset;
  2353. end;
  2354.  
  2355. function TCustomDBGrid.DataToRawColumn(ACol: Integer): Integer;
  2356. begin
  2357.   Result := ACol + FIndicatorOffset;
  2358. end;
  2359.  
  2360. function TCustomDBGrid.AcquireLayoutLock: Boolean;
  2361. begin
  2362.   Result := (FUpdateLock = 0) and (FLayoutLock = 0);
  2363.   if Result then BeginLayout;
  2364. end;
  2365.  
  2366. procedure TCustomDBGrid.BeginLayout;
  2367. begin
  2368.   BeginUpdate;
  2369.   if FLayoutLock = 0 then Columns.BeginUpdate;
  2370.   Inc(FLayoutLock);
  2371. end;
  2372.  
  2373. procedure TCustomDBGrid.BeginUpdate;
  2374. begin
  2375.   Inc(FUpdateLock);
  2376. end;
  2377.  
  2378. procedure TCustomDBGrid.CancelLayout;
  2379. begin
  2380.   if FLayoutLock > 0 then
  2381.   begin
  2382.     if FLayoutLock = 1 then
  2383.       Columns.EndUpdate;
  2384.     Dec(FLayoutLock);
  2385.     EndUpdate;
  2386.   end;
  2387. end;
  2388.  
  2389. function TCustomDBGrid.CanEditAcceptKey(Key: Char): Boolean;
  2390. begin
  2391.   with Columns[SelectedIndex] do
  2392.     Result := FDatalink.Active and Assigned(Field) and Field.IsValidChar(Key);
  2393. end;
  2394.  
  2395. function TCustomDBGrid.CanEditModify: Boolean;
  2396. begin
  2397.   Result := False;
  2398.   if not ReadOnly and FDatalink.Active and not FDatalink.Readonly then
  2399.   with Columns[SelectedIndex] do
  2400.     if (not ReadOnly) and Assigned(Field) and Field.CanModify
  2401.       and not Field.IsBlob then
  2402.     begin
  2403.       FDatalink.Edit;
  2404.       Result := FDatalink.Editing;
  2405.       if Result then FDatalink.Modified;
  2406.     end;
  2407. end;
  2408.  
  2409. function TCustomDBGrid.CanEditShow: Boolean;
  2410. begin
  2411.   Result := (LayoutLock = 0) and inherited CanEditShow;
  2412. end;
  2413.  
  2414. procedure TCustomDBGrid.CellClick(Column: TColumn);
  2415. begin
  2416.   if Assigned(FOnCellClick) then FOnCellClick(Column);
  2417. end;
  2418.  
  2419. procedure TCustomDBGrid.ColEnter;
  2420. begin
  2421.   if Assigned(FOnColEnter) then FOnColEnter(Self);
  2422. end;
  2423.  
  2424. procedure TCustomDBGrid.ColExit;
  2425. begin
  2426.   if Assigned(FOnColExit) then FOnColExit(Self);
  2427. end;
  2428.  
  2429. procedure TCustomDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  2430. begin
  2431.   FromIndex := RawToDataColumn(FromIndex);
  2432.   ToIndex := RawToDataColumn(ToIndex);
  2433.   Columns[FromIndex].Index := ToIndex;
  2434.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  2435. end;
  2436.  
  2437. procedure TCustomDBGrid.ColWidthsChanged;
  2438. var
  2439.   I: Integer;
  2440. begin
  2441.   inherited ColWidthsChanged;
  2442.   if (FDatalink.Active or (FColumns.State = csCustomized)) and
  2443.     AcquireLayoutLock then
  2444.   try
  2445.     for I := FIndicatorOffset to ColCount - 1 do
  2446.       FColumns[I - FIndicatorOffset].Width := ColWidths[I];
  2447.   finally
  2448.     EndLayout;
  2449.   end;
  2450. end;
  2451.  
  2452. function TCustomDBGrid.CreateColumns: TDBGridColumns;
  2453. begin
  2454.   Result := TDBGridColumns.Create(Self, TColumn);
  2455. end;
  2456.  
  2457. function TCustomDBGrid.CreateEditor: TInplaceEdit;
  2458. begin
  2459.   Result := TDBGridInplaceEdit.Create(Self);
  2460. end;
  2461.  
  2462. procedure TCustomDBGrid.CreateWnd;
  2463. begin
  2464.   BeginUpdate;   { prevent updates in WMSize message that follows WMCreate }
  2465.   try
  2466.     inherited CreateWnd;
  2467.   finally
  2468.     EndUpdate;
  2469.   end;
  2470.   UpdateRowCount;
  2471.   UpdateActive;
  2472.   UpdateScrollBar;
  2473. end;
  2474.  
  2475. procedure TCustomDBGrid.DataChanged;
  2476. begin
  2477.   if not HandleAllocated then Exit;
  2478.   UpdateRowCount;
  2479.   UpdateScrollBar;
  2480.   UpdateActive;
  2481.   InvalidateEditor;
  2482.   ValidateRect(Handle, nil);
  2483.   Invalidate;
  2484. end;
  2485.  
  2486. procedure TCustomDBGrid.DefaultHandler(var Msg);
  2487. var
  2488.   P: TPopupMenu;
  2489.   Cell: TGridCoord;
  2490. begin
  2491.   inherited DefaultHandler(Msg);
  2492.   if TMessage(Msg).Msg = wm_RButtonUp then
  2493.     with TWMRButtonUp(Msg) do
  2494.     begin
  2495.       Cell := MouseCoord(XPos, YPos);
  2496.       if (Cell.X < FIndicatorOffset) or (Cell.Y < 0) then Exit;
  2497.       P := Columns[RawToDataColumn(Cell.X)].PopupMenu;
  2498.       if (P <> nil) and P.AutoPopup then
  2499.       begin
  2500.         SendCancelMode(nil);
  2501.         P.PopupComponent := Self;
  2502.         with ClientToScreen(SmallPointToPoint(Pos)) do
  2503.           P.Popup(X, Y);
  2504.         Result := 1;
  2505.       end;
  2506.     end;
  2507. end;
  2508.  
  2509. procedure TCustomDBGrid.DeferLayout;
  2510. var
  2511.   M: TMsg;
  2512. begin
  2513.   if HandleAllocated and
  2514.     not PeekMessage(M, Handle, cm_DeferLayout, cm_DeferLayout, pm_NoRemove) then
  2515.     PostMessage(Handle, cm_DeferLayout, 0, 0);
  2516.   CancelLayout;
  2517. end;
  2518.  
  2519. procedure TCustomDBGrid.DefineFieldMap;
  2520. var
  2521.   I: Integer;
  2522. begin
  2523.   if FColumns.State = csCustomized then
  2524.   begin   { Build the column/field map from the column attributes }
  2525.     DataLink.SparseMap := True;
  2526.     for I := 0 to FColumns.Count-1 do
  2527.       FDataLink.AddMapping(FColumns[I].FieldName);
  2528.   end
  2529.   else   { Build the column/field map from the field list order }
  2530.   begin
  2531.     FDataLink.SparseMap := False;
  2532.     with Datalink.Dataset do
  2533.       for I := 0 to FieldCount - 1 do
  2534.         with Fields[I] do if Visible then Datalink.AddMapping(FieldName);
  2535.   end;
  2536. end;
  2537.  
  2538. procedure TCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
  2539.   State: TGridDrawState);
  2540. var
  2541.   Alignment: TAlignment;
  2542.   Value: string;
  2543. begin
  2544.   Alignment := taLeftJustify;
  2545.   Value := '';
  2546.   if Assigned(Field) then
  2547.   begin
  2548.     Alignment := Field.Alignment;
  2549.     Value := Field.DisplayText;
  2550.   end;
  2551.   WriteText(Canvas, Rect, 2, 2, Value, Alignment);
  2552. end;
  2553.  
  2554. procedure TCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
  2555.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  2556. var
  2557.   Value: string;
  2558. begin
  2559.   Value := '';
  2560.   if Assigned(Column.Field) then
  2561.     Value := Column.Field.DisplayText;
  2562.   WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment);
  2563. end;
  2564.  
  2565. procedure TCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
  2566. var
  2567.   OldActive: Integer;
  2568.   Indicator: Integer;
  2569.   Highlight: Boolean;
  2570.   Value: string;
  2571.   DrawColumn: TColumn;
  2572.   FrameOffs: Byte;
  2573. begin
  2574.   if csLoading in ComponentState then
  2575.   begin
  2576.     Canvas.Brush.Color := Color;
  2577.     Canvas.FillRect(ARect);
  2578.     Exit;
  2579.   end;
  2580.  
  2581.   Dec(ARow, FTitleOffset);
  2582.   Dec(ACol, FIndicatorOffset);
  2583.  
  2584.   if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
  2585.     [dgRowLines, dgColLines]) then
  2586.   begin
  2587.     InflateRect(ARect, -1, -1);
  2588.     FrameOffs := 1;
  2589.   end
  2590.   else
  2591.     FrameOffs := 2;
  2592.  
  2593.   if (gdFixed in AState) and (ACol < 0) then
  2594.   begin
  2595.     Canvas.Brush.Color := FixedColor;
  2596.     Canvas.FillRect(ARect);
  2597.     if Assigned(DataLink) and DataLink.Active and
  2598.       (ARow = FDataLink.ActiveRecord) then
  2599.     begin
  2600.       Indicator := 0;
  2601.       if FDataLink.DataSet <> nil then
  2602.         case FDataLink.DataSet.State of
  2603.           dsEdit: Indicator := 1;
  2604.           dsInsert: Indicator := 2;
  2605.         end;
  2606.       FIndicators.BkColor := FixedColor;
  2607.       FIndicators.Draw(Canvas, ARect.Right - FIndicators.Width - FrameOffs,
  2608.         (ARect.Top + ARect.Bottom - FIndicators.Height) shr 1, Indicator);
  2609.       FSelRow := ARow + FTitleOffset;
  2610.     end;
  2611.   end
  2612.   else with Canvas do
  2613.   begin
  2614.     DrawColumn := Columns[ACol];
  2615.     if gdFixed in AState then
  2616.     begin
  2617.       Font := DrawColumn.Title.Font;
  2618.       Brush.Color := DrawColumn.Title.Color;
  2619.     end
  2620.     else
  2621.     begin
  2622.       Font := DrawColumn.Font;
  2623.       Brush.Color := DrawColumn.Color;
  2624.     end;
  2625.     if ARow < 0 then with DrawColumn.Title do
  2626.       WriteText(Canvas, ARect, FrameOffs, FrameOffs, Caption, Alignment)
  2627.     else if (FDataLink = nil) or not FDataLink.Active then
  2628.       FillRect(ARect)
  2629.     else
  2630.     begin
  2631.       Value := '';
  2632.       OldActive := FDataLink.ActiveRecord;
  2633.       try
  2634.         FDataLink.ActiveRecord := ARow;
  2635.         if Assigned(DrawColumn.Field) then
  2636.           Value := DrawColumn.Field.DisplayText;
  2637.         Highlight := HighlightCell(ACol, ARow, Value, AState);
  2638.         if Highlight then
  2639.         begin
  2640.           Brush.Color := clHighlight;
  2641.           Font.Color := clHighlightText;
  2642.         end;
  2643.         if FDefaultDrawing then
  2644.           WriteText(Canvas, ARect, 2, 2, Value, DrawColumn.Alignment);
  2645.         if Columns.State = csDefault then
  2646.           DrawDataCell(ARect, DrawColumn.Field, AState);
  2647.         DrawColumnCell(ARect, ACol, DrawColumn, AState);
  2648.       finally
  2649.         FDataLink.ActiveRecord := OldActive;
  2650.       end;
  2651.       if FDefaultDrawing and (gdSelected in AState)
  2652.         and ((dgAlwaysShowSelection in Options) or Focused)
  2653.         and not (csDesigning in ComponentState)
  2654.         and not (dgRowSelect in Options)
  2655.         and (UpdateLock = 0)
  2656.         and (ValidParentForm(Self).ActiveControl = Self) then
  2657.         Windows.DrawFocusRect(Handle, ARect);
  2658.     end;
  2659.   end;
  2660.   if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
  2661.     [dgRowLines, dgColLines]) then
  2662.   begin
  2663.     InflateRect(ARect, 1, 1);
  2664.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  2665.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
  2666.   end;
  2667. end;
  2668.  
  2669. procedure TCustomDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  2670.   State: TGridDrawState);
  2671. begin
  2672.   if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, Rect, Field, State);
  2673. end;
  2674.  
  2675. procedure TCustomDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  2676.   Column: TColumn; State: TGridDrawState);
  2677. begin
  2678.   if Assigned(OnDrawColumnCell) then
  2679.     OnDrawColumnCell(Self, Rect, DataCol, Column, State);
  2680. end;
  2681.  
  2682. procedure TCustomDBGrid.EditButtonClick;
  2683. begin
  2684.   if Assigned(FOnEditButtonClick) then FOnEditButtonClick(Self);
  2685. end;
  2686.  
  2687. procedure TCustomDBGrid.EditingChanged;
  2688. begin
  2689.   if dgIndicator in Options then InvalidateCell(0, FSelRow);
  2690. end;
  2691.  
  2692. procedure TCustomDBGrid.EndLayout;
  2693. begin
  2694.   if FLayoutLock > 0 then
  2695.   begin
  2696.     try
  2697.       try
  2698.         if FLayoutLock = 1 then
  2699.           InternalLayout;
  2700.       finally
  2701.         if FLayoutLock = 1 then
  2702.           FColumns.EndUpdate;
  2703.       end;
  2704.     finally
  2705.       Dec(FLayoutLock);
  2706.       EndUpdate;
  2707.     end;
  2708.   end;
  2709. end;
  2710.  
  2711. procedure TCustomDBGrid.EndUpdate;
  2712. begin
  2713.   if FUpdateLock > 0 then
  2714.     Dec(FUpdateLock);
  2715. end;
  2716.  
  2717. function TCustomDBGrid.GetColField(DataCol: Integer): TField;
  2718. begin
  2719.   Result := nil;
  2720.   if (DataCol >= 0) and FDatalink.Active and (DataCol < Columns.Count) then
  2721.     Result := Columns[DataCol].Field;
  2722. end;
  2723.  
  2724. function TCustomDBGrid.GetDataSource: TDataSource;
  2725. begin
  2726.   Result := FDataLink.DataSource;
  2727. end;
  2728.  
  2729. function TCustomDBGrid.GetEditLimit: Integer;
  2730. begin
  2731.   Result := 0;
  2732.   if Assigned(SelectedField) and (SelectedField.DataType = ftString) then
  2733.     Result := SelectedField.Size;
  2734. end;
  2735.  
  2736. function TCustomDBGrid.GetEditMask(ACol, ARow: Longint): string;
  2737. begin
  2738.   Result := '';
  2739.   if FDatalink.Active then
  2740.   with Columns[RawToDataColumn(ACol)] do
  2741.     if Assigned(Field) then
  2742.       Result := Field.EditMask;
  2743. end;
  2744.  
  2745. function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
  2746. begin
  2747.   Result := '';
  2748.   if FDatalink.Active then
  2749.   with Columns[RawToDataColumn(ACol)] do
  2750.     if Assigned(Field) then
  2751.       Result := Field.Text;
  2752.   FEditText := Result;
  2753. end;
  2754.  
  2755. function TCustomDBGrid.GetFieldCount: Integer;
  2756. begin
  2757.   Result := FDatalink.FieldCount;
  2758. end;
  2759.  
  2760. function TCustomDBGrid.GetFields(FieldIndex: Integer): TField;
  2761. begin
  2762.   Result := FDatalink.Fields[FieldIndex];
  2763. end;
  2764.  
  2765. function TCustomDBGrid.GetFieldValue(ACol: Integer): string;
  2766. var
  2767.   Field: TField;
  2768. begin
  2769.   Result := '';
  2770.   Field := GetColField(ACol);
  2771.   if Field <> nil then Result := Field.DisplayText;
  2772. end;
  2773.  
  2774. function TCustomDBGrid.GetSelectedField: TField;
  2775. var
  2776.   Index: Integer;
  2777. begin
  2778.   Index := SelectedIndex;
  2779.   if Index <> -1 then
  2780.     Result := Columns[Index].Field
  2781.   else
  2782.     Result := nil;
  2783. end;
  2784.  
  2785. function TCustomDBGrid.GetSelectedIndex: Integer;
  2786. begin
  2787.   Result := RawToDataColumn(Col);
  2788. end;
  2789.  
  2790. function TCustomDBGrid.HighlightCell(DataCol, DataRow: Integer;
  2791.   const Value: string; AState: TGridDrawState): Boolean;
  2792. var
  2793.   Index: Integer;
  2794. begin
  2795.   Result := False;
  2796.   if (dgMultiSelect in Options) and Datalink.Active then
  2797.     Result := FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);
  2798.   if not Result then
  2799.     Result := (gdSelected in AState)
  2800.       and ((dgAlwaysShowSelection in Options) or Focused)
  2801.         { updatelock eliminates flicker when tabbing between rows }
  2802.       and ((UpdateLock = 0) or (dgRowSelect in Options));
  2803. end;
  2804.  
  2805. procedure TCustomDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
  2806. var
  2807.   KeyDownEvent: TKeyEvent;
  2808.  
  2809.   procedure ClearSelection;
  2810.   begin
  2811.     if (dgMultiSelect in Options) then
  2812.     begin
  2813.       FBookmarks.Clear;
  2814.       FSelecting := False;
  2815.     end;
  2816.   end;
  2817.  
  2818.   procedure DoSelection(Select: Boolean; Direction: Integer);
  2819.   var
  2820.     AddAfter: Boolean;
  2821.   begin
  2822.     AddAfter := False;
  2823.     BeginUpdate;
  2824.     try
  2825.       if (dgMultiSelect in Options) and FDatalink.Active then
  2826.         if Select and (ssShift in Shift) then
  2827.         begin
  2828.           if not FSelecting then
  2829.           begin
  2830.             FSelectionAnchor := FBookmarks.CurrentRow;
  2831.             FBookmarks.CurrentRowSelected := True;
  2832.             FSelecting := True;
  2833.             AddAfter := True;
  2834.           end
  2835.           else
  2836.           with FBookmarks do
  2837.           begin
  2838.             AddAfter := Compare(CurrentRow, FSelectionAnchor) <> -Direction;
  2839.             if not AddAfter then
  2840.               CurrentRowSelected := False;
  2841.           end
  2842.         end
  2843.         else
  2844.           ClearSelection;
  2845.       FDatalink.Dataset.MoveBy(Direction);
  2846.       if AddAfter then FBookmarks.CurrentRowSelected := True;
  2847.     finally
  2848.       EndUpdate;
  2849.     end;
  2850.   end;
  2851.  
  2852.   procedure NextRow(Select: Boolean);
  2853.   begin
  2854.     with FDatalink.Dataset do
  2855.     begin
  2856.       if (State = dsInsert) and not Modified and not FDatalink.FModified then
  2857.         if EOF then Exit else Cancel
  2858.       else
  2859.         DoSelection(Select, 1);
  2860.       if EOF and CanModify and (not ReadOnly) and (dgEditing in Options) then
  2861.         Append;
  2862.     end;
  2863.   end;
  2864.  
  2865.   procedure PriorRow(Select: Boolean);
  2866.   begin
  2867.     with FDatalink.Dataset do
  2868.       if (State = dsInsert) and not Modified and EOF and
  2869.         not FDatalink.FModified then
  2870.         Cancel
  2871.       else
  2872.         DoSelection(Select, -1);
  2873.   end;
  2874.  
  2875.   procedure Tab(GoForward: Boolean);
  2876.   var
  2877.     ACol, Original: Integer;
  2878.   begin
  2879.     ACol := Col;
  2880.     Original := ACol;
  2881.     BeginUpdate;    { Prevent highlight flicker on tab to next/prior row }
  2882.     try
  2883.       while True do
  2884.       begin
  2885.         if GoForward then
  2886.           Inc(ACol) else
  2887.           Dec(ACol);
  2888.         if ACol >= ColCount then
  2889.         begin
  2890.           NextRow(False);
  2891.           ACol := FIndicatorOffset;
  2892.         end
  2893.         else if ACol < FIndicatorOffset then
  2894.         begin
  2895.           PriorRow(False);
  2896.           ACol := ColCount;
  2897.         end;
  2898.         if ACol = Original then Exit;
  2899.         if TabStops[ACol] then
  2900.         begin
  2901.           MoveCol(ACol);
  2902.           Exit;
  2903.         end;
  2904.       end;
  2905.     finally
  2906.       EndUpdate;
  2907.     end;
  2908.   end;
  2909.  
  2910.   function DeletePrompt: Boolean;
  2911.   var
  2912.     Msg: string;
  2913.   begin
  2914.     if (FBookmarks.Count > 1) then
  2915.       Msg := SDeleteMultipleRecordsQuestion
  2916.     else
  2917.       Msg := SDeleteRecordQuestion;
  2918.     Result := not (dgConfirmDelete in Options) or
  2919.       (MessageDlg(Msg, mtConfirmation, mbOKCancel, 0) <> idCancel);
  2920.   end;
  2921.  
  2922. const
  2923.   RowMovementKeys = [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END];
  2924.  
  2925. begin
  2926.   KeyDownEvent := OnKeyDown;
  2927.   if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  2928.   if not FDatalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
  2929.   with FDatalink.DataSet do
  2930.     if ssCtrl in Shift then
  2931.     begin
  2932.       if (Key in RowMovementKeys) then ClearSelection;
  2933.       case Key of
  2934.         VK_UP, VK_PRIOR: MoveBy(-FDatalink.ActiveRecord);
  2935.         VK_DOWN, VK_NEXT: MoveBy(FDatalink.BufferCount - FDatalink.ActiveRecord - 1);
  2936.         VK_LEFT: MoveCol(FIndicatorOffset);
  2937.         VK_RIGHT: MoveCol(ColCount - 1);
  2938.         VK_HOME: First;
  2939.         VK_END: Last;
  2940.         VK_DELETE:
  2941.           if (not ReadOnly) and not IsEmpty 
  2942.             and CanModify and DeletePrompt then
  2943.           if FBookmarks.Count > 0 then
  2944.             FBookmarks.Delete
  2945.           else
  2946.             Delete;
  2947.       end
  2948.     end
  2949.     else
  2950.       case Key of
  2951.         VK_UP: PriorRow(True);
  2952.         VK_DOWN: NextRow(True);
  2953.         VK_LEFT:
  2954.           if dgRowSelect in Options then
  2955.             PriorRow(False) else
  2956.             MoveCol(Col - 1);
  2957.         VK_RIGHT:
  2958.           if dgRowSelect in Options then
  2959.             NextRow(False) else
  2960.             MoveCol(Col + 1);
  2961.         VK_HOME:
  2962.           if (ColCount = FIndicatorOffset+1)
  2963.             or (dgRowSelect in Options) then
  2964.           begin
  2965.             ClearSelection;
  2966.             First;
  2967.           end
  2968.           else
  2969.             MoveCol(FIndicatorOffset);
  2970.         VK_END:
  2971.           if (ColCount = FIndicatorOffset+1)
  2972.             or (dgRowSelect in Options) then
  2973.           begin
  2974.             ClearSelection;
  2975.             Last;
  2976.           end
  2977.           else
  2978.             MoveCol(ColCount - 1);
  2979.         VK_NEXT:
  2980.           begin
  2981.             ClearSelection;
  2982.             MoveBy(VisibleRowCount);
  2983.           end;
  2984.         VK_PRIOR:
  2985.           begin
  2986.             ClearSelection;
  2987.             MoveBy(-VisibleRowCount);
  2988.           end;
  2989.         VK_INSERT:
  2990.           if CanModify and (not ReadOnly) and (dgEditing in Options) then
  2991.           begin
  2992.             ClearSelection;
  2993.             Insert;
  2994.           end;
  2995.         VK_TAB: if not (ssAlt in Shift) then Tab(not (ssShift in Shift));
  2996.         VK_ESCAPE:
  2997.           begin
  2998.             FDatalink.Reset;
  2999.             ClearSelection;
  3000.             if not (dgAlwaysShowEditor in Options) then HideEditor;
  3001.           end;
  3002.         VK_F2: EditorMode := True;
  3003.       end;
  3004. end;
  3005.  
  3006. procedure TCustomDBGrid.KeyPress(var Key: Char);
  3007. begin
  3008.   if not (dgAlwaysShowEditor in Options) and (Key = #13) then
  3009.     FDatalink.UpdateData;
  3010.   inherited KeyPress(Key);
  3011. end;
  3012.  
  3013. { InternalLayout is called with layout locks and column locks in effect }
  3014. procedure TCustomDBGrid.InternalLayout;
  3015. var
  3016.   I, J, K: Integer;
  3017.   Fld: TField;
  3018.   Column: TColumn;
  3019.   SeenPassthrough: Boolean;
  3020.   RestoreCanvas: Boolean;
  3021.   M: TMsg;
  3022.  
  3023.   function FieldIsMapped(F: TField): Boolean;
  3024.   var
  3025.     X: Integer;
  3026.   begin
  3027.     Result := False;
  3028.     if F = nil then Exit;
  3029.     for X := 0 to FDatalink.FieldCount-1 do
  3030.       if FDatalink.Fields[X] = F then
  3031.       begin
  3032.         Result := True;
  3033.         Exit;
  3034.       end;
  3035.   end;
  3036.  
  3037. begin
  3038.   if (csLoading in ComponentState) then Exit;
  3039.  
  3040.   if HandleAllocated then
  3041.     PeekMessage(M, Handle, cm_DeferLayout, cm_DeferLayout, pm_Remove or pm_NoYield);
  3042.  
  3043.   { Check for Columns.State flip-flop }
  3044.   SeenPassthrough := False;
  3045.   for I := 0 to FColumns.Count-1 do
  3046.   begin
  3047.     if (FColumns[I] is TPassthroughColumn) then
  3048.       SeenPassthrough := True
  3049.     else
  3050.       if SeenPassthrough then
  3051.       begin   { We have both custom and passthrough columns. Kill the latter }
  3052.         for J := FColumns.Count-1 downto 0 do
  3053.         begin
  3054.           Column := FColumns[J];
  3055.           if Column is TPassthroughColumn then
  3056.             Column.Free;
  3057.         end;
  3058.         Break;
  3059.       end;
  3060.   end;
  3061.  
  3062.   FIndicatorOffset := 0;
  3063.   if dgIndicator in Options then
  3064.     Inc(FIndicatorOffset);
  3065.   FDatalink.ClearMapping;
  3066.   if FDatalink.Active then DefineFieldMap;
  3067.   if FColumns.State = csDefault then
  3068.   begin
  3069.      { Destroy columns whose fields have been destroyed or are no longer
  3070.        in field map }
  3071.     if (not FDataLink.Active) and (FDatalink.DefaultFields) then
  3072.       FColumns.Clear
  3073.     else
  3074.       for J := FColumns.Count-1 downto 0 do
  3075.         with FColumns[J] do
  3076.         if not Assigned(Field)
  3077.           or not FieldIsMapped(Field) then Free;
  3078.     I := FDataLink.FieldCount;
  3079.     if (I = 0) and (FColumns.Count = 0) then Inc(I);
  3080.     for J := 0 to I-1 do
  3081.     begin
  3082.       Fld := FDatalink.Fields[J];
  3083.       if Assigned(Fld) then
  3084.       begin
  3085.         K := J;
  3086.          { Pointer compare is valid here because the grid sets matching
  3087.            column.field properties to nil in response to field object
  3088.            free notifications.  Closing a dataset that has only default
  3089.            field objects will destroy all the fields and set associated
  3090.            column.field props to nil. }
  3091.         while (K < FColumns.Count) and (FColumns[K].Field <> Fld) do
  3092.           Inc(K);
  3093.         if K < FColumns.Count then
  3094.           Column := FColumns[K]
  3095.         else
  3096.         begin
  3097.           Column := TPassthroughColumn.Create(FColumns);
  3098.           Column.Field := Fld;
  3099.         end;
  3100.       end
  3101.       else
  3102.         Column := TPassthroughColumn.Create(FColumns);
  3103.       Column.Index := J;
  3104.     end;
  3105.   end
  3106.   else
  3107.   begin
  3108.     { Force columns to reaquire fields (in case dataset has changed) }
  3109.     for I := 0 to FColumns.Count-1 do
  3110.       FColumns[I].Field := nil;
  3111.   end;
  3112.   ColCount := FColumns.Count + FIndicatorOffset;
  3113.   inherited FixedCols := FIndicatorOffset;
  3114.   FTitleOffset := 0;
  3115.   if dgTitles in Options then FTitleOffset := 1;
  3116.   RestoreCanvas := not HandleAllocated;
  3117.   if RestoreCanvas then
  3118.     Canvas.Handle := GetDC(0);
  3119.   try
  3120.     Canvas.Font := Font;
  3121.     K := Canvas.TextHeight('Wg') + 3;
  3122.     if dgRowLines in Options then
  3123.       Inc(K, GridLineWidth);
  3124.     DefaultRowHeight := K;
  3125.     if dgTitles in Options then
  3126.     begin
  3127.       K := 0;
  3128.       for I := 0 to FColumns.Count-1 do
  3129.       begin
  3130.         Canvas.Font := FColumns[I].Title.Font;
  3131.         J := Canvas.TextHeight('Wg') + 4;
  3132.         if J > K then K := J;
  3133.       end;
  3134.       if K = 0 then
  3135.       begin
  3136.         Canvas.Font := FTitleFont;
  3137.         K := Canvas.TextHeight('Wg') + 4;
  3138.       end;
  3139.       RowHeights[0] := K;
  3140.     end;
  3141.   finally
  3142.     if RestoreCanvas then
  3143.     begin
  3144.       ReleaseDC(0,Canvas.Handle);
  3145.       Canvas.Handle := 0;
  3146.     end;
  3147.   end;
  3148.   UpdateRowCount;
  3149.   SetColumnAttributes;
  3150.   UpdateActive;
  3151.   Invalidate;
  3152. end;
  3153.  
  3154. procedure TCustomDBGrid.LayoutChanged;
  3155. begin
  3156.   if AcquireLayoutLock then
  3157.     EndLayout;
  3158. end;
  3159.  
  3160. procedure TCustomDBGrid.LinkActive(Value: Boolean);
  3161. begin
  3162.   if not Value then HideEditor;
  3163.   FBookmarks.LinkActive(Value);
  3164.   LayoutChanged;
  3165.   UpdateScrollBar;
  3166.   if Value and (dgAlwaysShowEditor in Options) then ShowEditor;
  3167. end;
  3168.  
  3169. procedure TCustomDBGrid.Loaded;
  3170. begin
  3171.   inherited Loaded;
  3172.   if FColumns.Count > 0 then
  3173.     ColCount := FColumns.Count;
  3174.   LayoutChanged;
  3175. end;
  3176.  
  3177. procedure TCustomDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  3178.   X, Y: Integer);
  3179. var
  3180.   Cell: TGridCoord;
  3181.   OldCol,OldRow: Integer;
  3182. begin
  3183.   if not AcquireFocus then Exit;
  3184.   if (ssDouble in Shift) and (Button = mbLeft) then
  3185.   begin
  3186.     DblClick;
  3187.     Exit;
  3188.   end;
  3189.   if Sizing(X, Y) then
  3190.   begin
  3191.     FDatalink.UpdateData;
  3192.     inherited MouseDown(Button, Shift, X, Y)
  3193.   end
  3194.   else
  3195.   begin
  3196.     Cell := MouseCoord(X, Y);
  3197.     if ((csDesigning in ComponentState) or (dgColumnResize in Options)) and
  3198.       (Cell.Y < FTitleOffset) then
  3199.     begin
  3200.       FDataLink.UpdateData;
  3201.       inherited MouseDown(Button, Shift, X, Y)
  3202.     end
  3203.     else
  3204.       if FDatalink.Active then
  3205.         with Cell do
  3206.         begin
  3207.           BeginUpdate;   { eliminates highlight flicker when selection moves }
  3208.           try
  3209.             HideEditor;
  3210.             OldCol := Col;
  3211.             OldRow := Row;
  3212.             if (Y >= FTitleOffset) and (Y - Row <> 0) then
  3213.               FDatalink.Dataset.MoveBy(Y - Row);
  3214.             if X >= FIndicatorOffset then
  3215.               MoveCol(X);
  3216.             if (dgMultiSelect in Options) and FDatalink.Active then
  3217.               with FBookmarks do
  3218.               begin
  3219.                 FSelecting := False;
  3220.                 if ssCtrl in Shift then
  3221.                   CurrentRowSelected := not CurrentRowSelected
  3222.                 else
  3223.                 begin
  3224.                   Clear;
  3225.                   CurrentRowSelected := True;
  3226.                 end;
  3227.               end;
  3228.             if (Button = mbLeft) and
  3229.               (((X = OldCol) and (Y = OldRow)) or (dgAlwaysShowEditor in Options)) then
  3230.               ShowEditor         { put grid in edit mode }
  3231.             else
  3232.               InvalidateEditor;  { draw editor, if needed }
  3233.           finally
  3234.             EndUpdate;
  3235.           end;
  3236.         end;
  3237.   end;
  3238. end;
  3239.  
  3240. procedure TCustomDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  3241.   X, Y: Integer);
  3242. var
  3243.   Cell: TGridCoord;
  3244.   SaveState: TGridState;
  3245. begin
  3246.   SaveState := FGridState;
  3247.   inherited MouseUp(Button, Shift, X, Y);
  3248.   if (SaveState = gsRowSizing) or (SaveState = gsColSizing) or
  3249.     ((InplaceEditor <> nil) and (InplaceEditor.Visible) and
  3250.      (PtInRect(InplaceEditor.BoundsRect, Point(X,Y)))) then Exit;
  3251.   Cell := MouseCoord(X,Y);
  3252.   if (Button = mbLeft) and (Cell.X >= FIndicatorOffset) and (Cell.Y >= 0) then
  3253.     if Cell.Y < FTitleOffset then
  3254.       TitleClick(Columns[RawToDataColumn(Cell.X)])
  3255.     else
  3256.       CellClick(Columns[SelectedIndex]);
  3257. end;
  3258.  
  3259. procedure TCustomDBGrid.MoveCol(RawCol: Integer);
  3260. var
  3261.   OldCol: Integer;
  3262. begin
  3263.   FDatalink.UpdateData;
  3264.   if RawCol >= ColCount then
  3265.     RawCol := ColCount - 1;
  3266.   if RawCol < FIndicatorOffset then RawCol := FIndicatorOffset;
  3267.   OldCol := Col;
  3268.   if RawCol <> OldCol then
  3269.   begin
  3270.     if not FInColExit then
  3271.     begin
  3272.       FInColExit := True;
  3273.       try
  3274.         ColExit;
  3275.       finally
  3276.         FInColExit := False;
  3277.       end;
  3278.       if Col <> OldCol then Exit;
  3279.     end;
  3280.     if not (dgAlwaysShowEditor in Options) then HideEditor;
  3281.     Col := RawCol;
  3282.     ColEnter;
  3283.   end;
  3284. end;
  3285.  
  3286. procedure TCustomDBGrid.Notification(AComponent: TComponent;
  3287.   Operation: TOperation);
  3288. var
  3289.   I: Integer;
  3290.   NeedLayout: Boolean;
  3291. begin
  3292.   inherited Notification(AComponent, Operation);
  3293.   if (Operation = opRemove) then
  3294.   begin
  3295.     if (AComponent is TPopupMenu) then
  3296.     begin
  3297.       for I := 0 to Columns.Count-1 do
  3298.         if Columns[I].PopupMenu = AComponent then
  3299.           Columns[I].PopupMenu := nil;
  3300.     end
  3301.     else if (FDataLink <> nil) then
  3302.       if (AComponent = DataSource)  then
  3303.         DataSource := nil
  3304.       else if (AComponent is TField) then
  3305.       begin
  3306.         NeedLayout := False;
  3307.         BeginLayout;
  3308.         try
  3309.           for I := 0 to Columns.Count-1 do
  3310.             with Columns[I] do
  3311.               if Field = AComponent then
  3312.               begin
  3313.                 Field := nil;
  3314.                 NeedLayout := True;
  3315.               end;
  3316.         finally
  3317.           if NeedLayout and Assigned(FDatalink.Dataset)
  3318.             and not FDatalink.Dataset.ControlsDisabled then
  3319.             EndLayout
  3320.           else
  3321.             DeferLayout;
  3322.         end;
  3323.       end;
  3324.   end;
  3325. end;
  3326.  
  3327. procedure TCustomDBGrid.RecordChanged(Field: TField);
  3328. var
  3329.   I: Integer;
  3330.   CField: TField;
  3331. begin
  3332.   if not HandleAllocated then Exit;
  3333.   if Field = nil then
  3334.     Invalidate
  3335.   else
  3336.   begin
  3337.     for I := 0 to Columns.Count - 1 do
  3338.       if Columns[I].Field = Field then
  3339.         InvalidateCol(DataToRawColumn(I));
  3340.   end;
  3341.   CField := SelectedField;
  3342.   if ((Field = nil) or (CField = Field)) and
  3343.     (Assigned(CField) and (CField.Text <> FEditText)) then
  3344.   begin
  3345.     InvalidateEditor;
  3346.     if InplaceEditor <> nil then InplaceEditor.Deselect;
  3347.   end;
  3348. end;
  3349.  
  3350. procedure TCustomDBGrid.Scroll(Distance: Integer);
  3351. var
  3352.   OldRect, NewRect: TRect;
  3353.   RowHeight: Integer;
  3354. begin
  3355.   OldRect := BoxRect(0, Row, ColCount - 1, Row);
  3356.   UpdateScrollBar;
  3357.   UpdateActive;
  3358.   NewRect := BoxRect(0, Row, ColCount - 1, Row);
  3359.   ValidateRect(Handle, @OldRect);
  3360.   InvalidateRect(Handle, @OldRect, False);
  3361.   InvalidateRect(Handle, @NewRect, False);
  3362.   if Distance <> 0 then
  3363.   begin
  3364.     HideEditor;
  3365.     try
  3366.       if Abs(Distance) > VisibleRowCount then
  3367.       begin
  3368.         Invalidate;
  3369.         Exit;
  3370.       end
  3371.       else
  3372.       begin
  3373.         RowHeight := DefaultRowHeight;
  3374.         if dgRowLines in Options then Inc(RowHeight, GridLineWidth);
  3375.         NewRect := BoxRect(FIndicatorOffset, FTitleOffset, ColCount - 1, 1000);
  3376.         ScrollWindowEx(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect,
  3377.           0, nil, SW_Invalidate);
  3378.         if dgIndicator in Options then
  3379.         begin
  3380.           OldRect := BoxRect(0, FSelRow, ColCount - 1, FSelRow);
  3381.           InvalidateRect(Handle, @OldRect, False);
  3382.           NewRect := BoxRect(0, Row, ColCount - 1, Row);
  3383.           InvalidateRect(Handle, @NewRect, False);
  3384.         end;
  3385.       end;
  3386.     finally
  3387.       if dgAlwaysShowEditor in Options then ShowEditor;
  3388.     end;
  3389.   end;
  3390.   if UpdateLock = 0 then Update;
  3391. end;
  3392.  
  3393. procedure TCustomDBGrid.SetColumns(Value: TDBGridColumns);
  3394. begin
  3395.   Columns.Assign(Value);
  3396. end;
  3397.  
  3398. function ReadOnlyField(Field: TField): Boolean;
  3399. var
  3400.   MasterField: TField;
  3401. begin
  3402.   Result := Field.ReadOnly;
  3403.   if not Result and (Field.FieldKind = fkLookup) then
  3404.   begin
  3405.     Result := True;
  3406.     if Field.DataSet = nil then Exit;
  3407.     MasterField := Field.Dataset.FindField(Field.KeyFields);
  3408.     if MasterField = nil then Exit;
  3409.     Result := MasterField.ReadOnly;
  3410.   end;
  3411. end;
  3412.  
  3413. procedure TCustomDBGrid.SetColumnAttributes;
  3414. var
  3415.   I: Integer;
  3416. begin
  3417.   for I := 0 to FColumns.Count-1 do
  3418.   with FColumns[I] do
  3419.   begin
  3420.     TabStops[I + FIndicatorOffset] := not ReadOnly and DataLink.Active and
  3421.       Assigned(Field) and not (Field.FieldKind = fkCalculated) and not ReadOnlyField(Field);
  3422.     ColWidths[I + FIndicatorOffset] := Width;
  3423.   end;
  3424.   if (dgIndicator in Options) then
  3425.     ColWidths[0] := IndicatorWidth;
  3426. end;
  3427.  
  3428. procedure TCustomDBGrid.SetDataSource(Value: TDataSource);
  3429. begin
  3430.   if Value = FDatalink.Datasource then Exit;
  3431.   FBookmarks.Clear;
  3432.   FDataLink.DataSource := Value;
  3433.   if Value <> nil then Value.FreeNotification(Self);
  3434.   LinkActive(FDataLink.Active);
  3435. end;
  3436.  
  3437. procedure TCustomDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  3438. begin
  3439.   FEditText := Value;
  3440. end;
  3441.  
  3442. procedure TCustomDBGrid.SetOptions(Value: TDBGridOptions);
  3443. const
  3444.   LayoutOptions = [dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
  3445.     dgColLines, dgRowLines, dgRowSelect, dgAlwaysShowSelection];
  3446. var
  3447.   NewGridOptions: TGridOptions;
  3448.   ChangedOptions: TDBGridOptions;
  3449. begin
  3450.   if FOptions <> Value then
  3451.   begin
  3452.     NewGridOptions := [];
  3453.     if dgColLines in Value then
  3454.       NewGridOptions := NewGridOptions + [goFixedVertLine, goVertLine];
  3455.     if dgRowLines in Value then
  3456.       NewGridOptions := NewGridOptions + [goFixedHorzLine, goHorzLine];
  3457.     if dgColumnResize in Value then
  3458.       NewGridOptions := NewGridOptions + [goColSizing, goColMoving];
  3459.     if dgTabs in Value then Include(NewGridOptions, goTabs);
  3460.     if dgRowSelect in Value then
  3461.     begin
  3462.       Include(NewGridOptions, goRowSelect);
  3463.       Exclude(Value, dgAlwaysShowEditor);
  3464.       Exclude(Value, dgEditing);
  3465.     end;
  3466.     if dgEditing in Value then Include(NewGridOptions, goEditing);
  3467.     if dgAlwaysShowEditor in Value then Include(NewGridOptions, goAlwaysShowEditor);
  3468.     inherited Options := NewGridOptions;
  3469.     if dgMultiSelect in (FOptions - Value) then FBookmarks.Clear;
  3470.     ChangedOptions := (FOptions + Value) - (FOptions * Value);
  3471.     FOptions := Value;
  3472.     if ChangedOptions * LayoutOptions <> [] then LayoutChanged;
  3473.   end;
  3474. end;
  3475.  
  3476. procedure TCustomDBGrid.SetSelectedField(Value: TField);
  3477. var
  3478.   I: Integer;
  3479. begin
  3480.   if Value = nil then Exit;
  3481.   for I := 0 to Columns.Count - 1 do
  3482.     if Columns[I].Field = Value then
  3483.       MoveCol(DataToRawColumn(I));
  3484. end;
  3485.  
  3486. procedure TCustomDBGrid.SetSelectedIndex(Value: Integer);
  3487. begin
  3488.   MoveCol(DataToRawColumn(Value));
  3489. end;
  3490.  
  3491. procedure TCustomDBGrid.SetTitleFont(Value: TFont);
  3492. begin
  3493.   FTitleFont.Assign(Value);
  3494.   if dgTitles in Options then LayoutChanged;
  3495. end;
  3496.  
  3497. function TCustomDBGrid.StoreColumns: Boolean;
  3498. begin
  3499.   Result := Columns.State = csCustomized;
  3500. end;
  3501.  
  3502. procedure TCustomDBGrid.TimedScroll(Direction: TGridScrollDirection);
  3503. begin
  3504.   if FDatalink.Active then
  3505.   begin
  3506.     with FDatalink do
  3507.     begin
  3508.       if sdUp in Direction then
  3509.       begin
  3510.         DataSet.MoveBy(-ActiveRecord - 1);
  3511.         Exclude(Direction, sdUp);
  3512.       end;
  3513.       if sdDown in Direction then
  3514.       begin
  3515.         DataSet.MoveBy(RecordCount - ActiveRecord);
  3516.         Exclude(Direction, sdDown);
  3517.       end;
  3518.     end;
  3519.     if Direction <> [] then inherited TimedScroll(Direction);
  3520.   end;
  3521. end;
  3522.  
  3523. procedure TCustomDBGrid.TitleClick(Column: TColumn);
  3524. begin
  3525.   if Assigned(FOnTitleClick) then FOnTitleClick(Column);
  3526. end;
  3527.  
  3528. procedure TCustomDBGrid.TitleFontChanged(Sender: TObject);
  3529. begin
  3530.   if (not FSelfChangingTitleFont) and not (csLoading in ComponentState) then
  3531.     ParentFont := False;
  3532.   if dgTitles in Options then LayoutChanged;
  3533. end;
  3534.  
  3535. procedure TCustomDBGrid.UpdateActive;
  3536. var
  3537.   NewRow: Integer;
  3538.   Field: TField;
  3539. begin
  3540.   if FDatalink.Active and HandleAllocated and not (csLoading in ComponentState) then
  3541.   begin
  3542.     NewRow := FDatalink.ActiveRecord + FTitleOffset;
  3543.     if Row <> NewRow then
  3544.     begin
  3545.       if not (dgAlwaysShowEditor in Options) then HideEditor;
  3546.       MoveColRow(Col, NewRow, False, False);
  3547.       InvalidateEditor;
  3548.     end;
  3549.     Field := SelectedField;
  3550.     if Assigned(Field) and (Field.Text <> FEditText) then
  3551.       InvalidateEditor;
  3552.   end;
  3553. end;
  3554.  
  3555. procedure TCustomDBGrid.UpdateData;
  3556. var
  3557.   Field: TField;
  3558. begin
  3559.   Field := SelectedField;
  3560.   if Assigned(Field) then
  3561.     Field.Text := FEditText;
  3562. end;
  3563.  
  3564. procedure TCustomDBGrid.UpdateRowCount;
  3565. begin
  3566.   if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
  3567.   FixedRows := FTitleOffset;
  3568.   with FDataLink do
  3569.     if not Active or (RecordCount = 0) or not HandleAllocated then
  3570.       RowCount := 1 + FTitleOffset
  3571.     else
  3572.     begin
  3573.       RowCount := 1000;
  3574.       FDataLink.BufferCount := VisibleRowCount;
  3575.       RowCount := RecordCount + FTitleOffset;
  3576.       if dgRowSelect in Options then TopRow := FixedRows;
  3577.       UpdateActive;
  3578.     end;
  3579. end;
  3580.  
  3581. procedure TCustomDBGrid.UpdateScrollBar;
  3582. var
  3583.   Pos: Integer;
  3584. begin
  3585.   if FDatalink.Active and HandleAllocated then
  3586.     with FDatalink.DataSet do
  3587.     begin
  3588.       SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
  3589.       if BOF then Pos := 0
  3590.       else if EOF then Pos := 4
  3591.       else Pos := 2;
  3592.       if GetScrollPos(Self.Handle, SB_VERT) <> Pos then
  3593.         SetScrollPos(Self.Handle, SB_VERT, Pos, True);
  3594.     end;
  3595. end;
  3596.  
  3597. function TCustomDBGrid.ValidFieldIndex(FieldIndex: Integer): Boolean;
  3598. begin
  3599.   Result := DataLink.GetMappedIndex(FieldIndex) >= 0;
  3600. end;
  3601.  
  3602. procedure TCustomDBGrid.CMParentFontChanged(var Message: TMessage);
  3603. begin
  3604.   inherited;
  3605.   if ParentFont then
  3606.   begin
  3607.     FSelfChangingTitleFont := True;
  3608.     try
  3609.       TitleFont := Font;
  3610.     finally
  3611.       FSelfChangingTitleFont := False;
  3612.     end;
  3613.     LayoutChanged;
  3614.   end;
  3615. end;
  3616.  
  3617. procedure TCustomDBGrid.CMExit(var Message: TMessage);
  3618. begin
  3619.   try
  3620.     if FDatalink.Active then
  3621.       with FDatalink.Dataset do
  3622.         if (dgCancelOnExit in Options) and (State = dsInsert) and
  3623.           not Modified and not FDatalink.FModified then
  3624.           Cancel else
  3625.           FDataLink.UpdateData;
  3626.   except
  3627.     SetFocus;
  3628.     raise;
  3629.   end;
  3630.   inherited;
  3631. end;
  3632.  
  3633. procedure TCustomDBGrid.CMFontChanged(var Message: TMessage);
  3634. var
  3635.   I: Integer;
  3636. begin
  3637.   inherited;
  3638.   BeginLayout;
  3639.   try
  3640.     for I := 0 to Columns.Count-1 do
  3641.       Columns[I].RefreshDefaultFont;
  3642.   finally
  3643.     EndLayout;
  3644.   end;
  3645. end;
  3646.  
  3647. procedure TCustomDBGrid.CMDeferLayout(var Message);
  3648. begin
  3649.   if AcquireLayoutLock then
  3650.     EndLayout
  3651.   else
  3652.     DeferLayout;
  3653. end;
  3654.  
  3655. procedure TCustomDBGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
  3656. begin
  3657.   inherited;
  3658. {!!  if Msg.Result = 1 then
  3659.     with MouseCoord(Msg.Pos.X, Msg.Pos.Y) do
  3660.       Msg.Result := Longint( (X >= FIndicatorOffset) and (Y < FTitleOffset) );
  3661. }  if (Msg.Result = 1) and ((FDataLink = nil) or
  3662.     ((Columns.State = csDefault) and
  3663.      (FDataLink.DefaultFields or (not FDataLink.Active)))) then
  3664.     Msg.Result := 0;
  3665. end;
  3666.  
  3667. procedure TCustomDBGrid.WMSetCursor(var Msg: TWMSetCursor);
  3668. begin
  3669.   if (csDesigning in ComponentState) and ((FDataLink = nil) or
  3670.      ((Columns.State = csDefault) and
  3671.       (FDataLink.DefaultFields or (not FDataLink.Active)))) then
  3672.     Windows.SetCursor(LoadCursor(0, IDC_ARROW))
  3673.   else inherited;
  3674. end;
  3675.  
  3676. procedure TCustomDBGrid.WMSize(var Message: TWMSize);
  3677. begin
  3678.   inherited;
  3679.   if UpdateLock = 0 then UpdateRowCount;
  3680. end;
  3681.  
  3682. procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
  3683. begin
  3684.   if not AcquireFocus then Exit;
  3685.   if FDatalink.Active then
  3686.     with Message, FDataLink.DataSet, FDatalink do
  3687.       case ScrollCode of
  3688.         SB_LINEUP: MoveBy(-ActiveRecord - 1);
  3689.         SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
  3690.         SB_PAGEUP: MoveBy(-VisibleRowCount);
  3691.         SB_PAGEDOWN: MoveBy(VisibleRowCount);
  3692.         SB_THUMBPOSITION:
  3693.           begin
  3694.             case Pos of
  3695.               0: First;
  3696.               1: MoveBy(-VisibleRowCount);
  3697.               2: Exit;
  3698.               3: MoveBy(VisibleRowCount);
  3699.               4: Last;
  3700.             end;
  3701.           end;
  3702.         SB_BOTTOM: Last;
  3703.         SB_TOP: First;
  3704.       end;
  3705. end;
  3706.  
  3707. end.
  3708.